?Page ?NOCODE, NOICODE, NOMAP, NOCROSSREF, NOSYMBOLS, NOINSPECT, NOSAVEABEND !############################################################################# !# # !# PRTFBA : Version 1.01.01 # !# Mark Dickinson # !# 09 June 1997 # !# # !# (c)Mark Dickinson, all rights reserved. # !# # !# # !# Function : Copy all jobs at a specific spool location to a disk file # !# in IBM FBA print format for later printing on an IBM # !# system (should anyone want to do so). # !# # !# Example useage: # !# add define =prtfba_logfile , class map, file $0 # !# add define =prtfba_spl_source , class map, file $spls.#report.stuff # !# add define =prtfba_target_file, class map, file $data01.rptdata.stuff # !# add define =prtfba_spooler_action, class map, file $HOLD # !# run prtfba /name/ # !# # !# # !# Disk Output File notes: # !# The output file needs to have been pre-created by the user to avoid # !# problems with the program creating a default file that would be too # !# small. # !# All data written to the file is "appended" to existing data. This # !# allows reports/reruns to be concatenated to the original. THIS MEANS # !# IT IS UP TO THE USER to ensure that a purgedata is done on the file # !# before a new days batch run starts. # !# # !# # !# Spooler notes: # !# To access a jobs data under the spooler the following steps are # !# required, and must be vigourously obeyed (and checked) at every step # !# ...open the spool supervisor # !# ...query the spool supervisor for data on the job # !# ...use the returned data to idendify the spool data file # !# ...open the spooler datafile # !# ...use the spooler to initialise a print control buffer # !# ...use printstart to acces the data stream # !# # !# # !# Changed # !# 09 Jun 1997 - Created # !# 15 Mar 1999 - Altered to use D45 spooler procedures2 as the pre-D45 # !# procedures do not work with the D45 spooler subsystem. # !# # !############################################################################# ?Page "Globals" -- Constant information at offset 0 in ALL Marks programming for -- debugging purposes (to allow matchup with correct source files). String Version^ID[0:25] := ["PRTFBA:V1.01.01:1999/03/15"]; -- Constants used. Literal True = -1, False = 0, -- Constants for completion code types. Fatal^Error^Code = 3, Warning^Error^Code = 1, No^Error^Code = 0, -- Constants for the finam action against the spooler job Delete^Job = 1, Hold^Job = 2; -- The output file for the report in FBA or ANSI format String Disk^File^Name[0:36] := 37 * [0]; Int Disk^File := -2, !Output file if used Disk^File^Namelen, !needed by file_open_ Disk^File^Type; !Output device type -- The status and error log file name, should be an EMS collector String Log^File^Name[0:36] := 37 * [0]; Int Log^File := -2, !Status and error file Log^File^Namelen := 0; !needed by file_open_ -- The print supervisor process, use C Series compatible calls String Spool^Supervisor[0:36] := 37 * [0]; Int Spool := -2, !Spool file number Spool^Name^Len, -- Spooler interface buffers .SpoolBuff[0:127], !Spool comms buffer area .JobBuff[0:559], !Job Control buffer for perusal .JobPrintBuff[0:127], !Print Control Buffer for perusal .JobDataBuff[0:449], !Data buffer for perusal JobPage := 0; !Active page for perusal -- Our job selection by location String Loc^Key[0:15] := ["#prtfba location"]; !Location select c -- Stuff required to access the data for a specific job Int Key := -1; String Active^Data^Name[0:36] := 37 * [0]; Int Active^Data^Namelen, Active^Data^File := -1, !Jobs datafile file number Select^Loc := 0, !Loc select flag Select^Loc^Len := 0; !Select value len -- General Purpose Int Error := 0, !Error variable .Buffer[0:559], !Misc I/O Buffer, Max Out Size 560 word I, Count^Read; -- Error info to pass pack to the caller by stop or abend. String Error^Text[0:127]; !Text passed back Int Error^Text^Len := 0, !true length of above to be passed back Completion^Code := 0; !0=Ok, 2=Warn etc. refer to Tandem prog !reference guide for details. -- Miscellaneous Pointers String .S^Buffer := @Buffer '<<' 1, .S^SpoolBuff := @SpoolBuff '<<' 1, .Ptr; -- Job number table we will use to record jobs to be deleted Literal MAXJOBS = 100; Int .Job^Table[0:MAXJOBS-1], JobEntryCount := 0, Spooler^Final^Action := Delete^Job; -- The spooler data structure record we will be using. Struct Spooler^Job^Def(*); Begin Int Number, !job number State; !job state Struct location; Begin string group[0:7], destination[0:7]; End; String form^name[0:15], report^name[0:15]; Int Flags, page^size, owner^id, copies, pages, lines, time^opened[0:2], time^closed[0:2]; Struct data^file; begin int volume[0:3], subvolume[0:3], filename[0:3]; end; string collector^process^name[0:5]; int units^allocated; int gmom^crtpid^jobid[0:4]; ! Netbatch info written here int(32) max^lines, max^pages; int batch^name[0:15], batch^id; End; ! -------------- EMS Stuff -------------- ?NOLIST, SOURCE $SYSTEM.SYSTEM.GPLDEFS ?LIST ?NOLIST, SOURCE $SYSTEM.ZSPIDEF.ZSPITAL ?LIST ?NOLIST, SOURCE $SYSTEM.ZSPIDEF.ZEMSTAL ?LIST ! SCHEMA PRODUCED DATE - TIME : 6/09/97 12:18:55 ?Section PRTFBA^EVENT^NUMBERS ! Constant PRTFBA-EVT-JOB-STARTED created on 06/09/97 at 12:18 Literal PRTFBA^EVT^JOB^STARTED = 1; ! Constant PRTFBA-EVT-JOB-COMPLETED created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^COMPLETED = 2; ! Constant PRTFBA-EVT-JOB-TOTALS created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^TOTALS = 3; ! Constant PRTFBA-EVT-PGM-START created on 06/09/97 at 12:19 Literal PRTFBA^EVT^PGM^START = 4; ! Constant PRTFBA-EVT-PGM-END-OK created on 06/09/97 at 12:19 Literal PRTFBA^EVT^PGM^END^OK = 5; ! Constant PRTFBA-EVT-PGM-END-FAILED created on 06/09/97 at 12:19 Literal PRTFBA^EVT^PGM^END^FAILED = 6; ! Constant PRTFBA-EVT-JOB-DELETED created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^DELETED = 7; ! Constant PRTFBA-EVT-JOB-HELD created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^HELD = 8; ! Constant PRTFBA-EVT-JOB-PURGE-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^PURGE^ERROR = 101; ! Constant PRTFBA-EVT-JOB-HOLD-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^JOB^HOLD^ERROR = 102; ! Constant PRTFBA-EVT-NO-JOBS-FOUND created on 06/09/97 at 12:19 Literal PRTFBA^EVT^NO^JOBS^FOUND = 301; ! Constant PRTFBA-EVT-NO-REQUIRED-DEFINE created on 06/09/97 at 12:19 Literal PRTFBA^EVT^NO^REQUIRED^DEFINE = 302; ! Constant PRTFBA-EVT-BAD-REQUIRED-DEFINE created on 06/09/97 at 12:19 Literal PRTFBA^EVT^BAD^REQUIRED^DEFINE = 303; ! Constant PRTFBA-EVT-NO-BUFFER-SPACE created on 06/09/97 at 12:19 Literal PRTFBA^EVT^NO^BUFFER^SPACE = 304; ! Constant PRTFBA-EVT-PROGRAMMER-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^PROGRAMMER^ERROR = 305; ! Constant PRTFBA-EVT-FILE-OPEN-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^FILE^OPEN^ERROR = 306; ! Constant PRTFBA-EVT-SPLDATA-OPEN-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^SPLDATA^OPEN^ERROR = 307; ! Constant PRTFBA-EVT-SPLDATA-BAD-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^SPLDATA^BAD^ERROR = 308; ! Constant PRTFBA-EVT-SPLDATA-READ-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^SPLDATA^READ^ERROR = 309; ! Constant PRTFBA-EVT-GENERIC-SPL-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^GENERIC^SPL^ERROR = 310; ! Constant PRTFBA-EVT-FILE-IO-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^FILE^IO^ERROR = 311; ! Constant PRTFBA-EVT-FILE-LRECL-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^FILE^LRECL^ERROR = 312; ! Constant PRTFBA-EVT-FILE-ACCESS-ERROR created on 06/09/97 at 12:19 Literal PRTFBA^EVT^FILE^ACCESS^ERROR = 313; ! Constant PRTFBA-ACTION-ID-1 created on 06/09/97 at 12:19 Literal PRTFBA^ACTION^ID^1 = 1; ! Constant PRTFBA-ACTION-ID-2 created on 06/09/97 at 12:19 Literal PRTFBA^ACTION^ID^2 = 2; ! Constant PRTFBA-ACTION-ID-3 created on 06/09/97 at 12:19 Literal PRTFBA^ACTION^ID^3 = 3; ! Constant PRTFBA-ACTION-ID-4 created on 06/09/97 at 12:19 Literal PRTFBA^ACTION^ID^4 = 4; ! Constant PRTFBA-VAL-FALSE created on 06/09/97 at 12:19 Literal PRTFBA^VAL^FALSE = 0; ! Constant PRTFBA-VAL-TRUE created on 06/09/97 at 12:19 Literal PRTFBA^VAL^TRUE = 1; ! Constant ZSPI-VAL-TECHSERV created on 06/09/97 at 12:19 Define ZSPI^VAL^TECHSERV = "TECHSERV"#; ! Constant ZSPI-SSN-PRTFBA created on 06/09/97 at 12:19 Literal ZSPI^SSN^PRTFBA = 1; ! Constant ZEMS-VAL-VERSION-PRTFBA created on 06/09/97 at 12:19 Literal ZEMS^VAL^VERSION^PRTFBA = 1; ! ! SSIDs used in generating event messages ! LITERAL ssid^size = ($LEN( ZSPI^DDL^SSID^DEF ) + 1) / 2; INT .our^ssid[0:ssid^size - 1] := [zspi^val^techserv, zspi^SSN^prtfba, zems^val^version^prtfba], .ems^ssid[0:ssid^size-1] := [ZSPI^VAL^TANDEM, ZSPI^SSN^ZEMS, ZEMS^VAL^VERSION]; ! ! This is the buffer in which event messages are built ! STRUCT .event^buf( zems^ddl^evt^buffer^def ); LITERAL event^buf^size = $LEN( zems^ddl^evt^buffer^def ); ! ! A place to save the token value when putting it into an event message ! STRING .evt^txt[0:201], .sptr; -- a string pointer used in calculations ! ! SS or EMS PUT of values cannot be literals ! INT true^val := ZSPI^VAL^TRUE, false^val := ZSPI^VAL^FALSE; ! ! Defines used ! Define Blank( A, B ) = A ':=' " " & A For (B - 1)#; Define ZeroFill( A, B ) = A ':=' 0 & A For (B - 1)#; ?Page ?NOLIST ?Source $SYSTEM.SYSTEM.EXTDECS0( ?CANCEL, ?DEFINEINFO, ?EMSADDTOKENS, ?EMSINIT, ?FILEINFO, ?FILE_OPEN_, ?FILE_CLOSE_, ?FILE_GETINFOLISTBYNAME_, ?FNAMECOLLAPSE, ?FNAMEEXPAND, ?NUMIN, ?NUMOUT, ?PRINTREAD, ?PRINTSTART2, ?PROCESS_STOP_, ?READ, ?SHIFTSTRING, ?SPOOLERCOMMAND, ?SPOOLEREQUEST2, ?SPOOLERSTATUS2, ?SSGETTKN, ?WRITE, ?WRITEREAD) ?LIST ?PAGE "Forward Declarations" Int Proc Do^All^Initialisation; Forward; Proc Process^All^Matching^Jobs; Forward; Int Proc Access^Spooler^Datafile; Forward; Proc Delete^Spooled^Job( Job^Number ); Int Job^Number; Forward; Int Proc Do^Spooler^Query( Cmd^Code, Scan^Type ); Int Cmd^Code, Scan^Type; Forward; Int Proc List^All^Job^Pages; Forward; Int Proc Open^Spool^Supervisor; Forward; Proc Spooler^Error( Error ); Int Error; Forward; Int Proc Write^To^Disk^File( databuf, databuflen ); Int .databuf, databuflen; Forward; PROC write^event^message( num, io^msg, io^len, emphasis ); INT num; -- event number passed by user STRING .io^msg; -- msg received at end of the wait INT io^len; -- length of the msg INT emphasis; -- indicates if critical or not Forward; ?Page "PRTFBA^Mainline^990315" !############################################################################ !# # !# Procedure : PRTFBA^Mainline^990315 # !# # !# This procedure calls the initialisation routine, and if OK calls the # !# procedure to handle scanning the spooler jobs. # !# On return from the spooler job stuff it checks to see if we had a # !# successful run, and if loops to delete all the jobs we printed OK. # !# It then closes all the open files and exists. # !# # !# All the rest of the code is just status/error message display. # !# # !# NOTE: We return a completion-code and text message when we exit the # !# program. These can be checked from within the TACL :_completion # !# var. # !# # !############################################################################ Proc PRTFBA^Mainline^990315 MAIN; Begin If Do^All^Initialisation Then Begin !If we get startup and open files Completion^Code := No^Error^Code; JobEntryCount := 0; -- no jobs found yet ! Search thru all spooled jobs for the ones that match our location ! and flick the contents out to our FBA disk file. Call Process^All^Matching^Jobs; If ((JobEntryCount > 0) AND (Completion^Code < Fatal^Error^Code)) Then Begin For I := 0 To (JobEntryCount - 1) Do Begin Call Delete^Spooled^Job( Job^Table[I] ); End; End Else If (JobEntryCount = 0) Then Begin -- no jobs found matching out crite Completion^Code := Fatal^Error^Code; Error^Text ':=' "NO JOBS FOUND AT LOCATION " & Loc^Key for Select^Loc^Len -> @Ptr; Error^Text^Len := @Ptr '-' @Error^Text; Write^Event^Message( Prtfba^evt^no^jobs^found, Error^Text, Error^Text^Len, True ); End; -- else error messages have already been logged/setup. End; !---- If all was OK, log another message ----- If (Completion^Code < Fatal^Error^Code) Then Begin Error^Text ':=' Spool^Supervisor for Spool^Name^Len & "." & Loc^Key for Select^Loc^Len & ", nnnnn JOBS PROCESSED" -> @Ptr; Call Numout(Ptr[-20], JobEntryCount, 10, 5 ); Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( prtfba^evt^job^totals, Error^Text, Error^Text^Len, False ); ! Use s^buffer to avoid overwriting the error^text to return to TACL S^Buffer ':=' "RQST: " & Spool^Supervisor for Spool^Name^Len & "." & Loc^Key for Select^Loc^Len & " COMPLETED" -> @Ptr; Call Write^Event^Message( prtfba^evt^pgm^end^ok, S^Buffer, (@Ptr '-' @S^Buffer), False ); End Else Begin ! Use s^buffer to avoid overwriting the error^text to return to TACL S^Buffer ':=' "RQST: " & Spool^Supervisor for Spool^Name^Len & "." & Loc^Key for Select^Loc^Len & " FAILED" -> @Ptr; Call Write^Event^Message( prtfba^evt^pgm^end^failed, S^Buffer, (@Ptr '-' @S^Buffer), False ); End; !---- Close any files we have used ---- If (Active^Data^File > 0) Then Error := File_Close_(Active^Data^File); If (Spool > 0) Then Error := File_Close_( Spool ); If (Disk^File > 0) Then Error := File_Close_( Disk^File ); If (Log^File > 0) Then Error := File_Close_( Log^File ); !---- Return an appropriate error code if required (for netbatch) ---- If Error^Text^Len > 80 Then Error^Text^Len := 80; -- max for stop call Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!, Completion^Code,,, Error^Text:Error^Text^Len ); If (Error <> 0) Then Begin -- we didn't stop, abend Error := Process_Stop_(!stop me!,1 !both process pairs!,1 !abend!, Completion^Code,,, Error^Text:Error^Text^Len ); End; End; ! End of proc PRTFBA^Mainline^990315 MAIN ?Page "Do^All^Initialisation" !############################################################################ !# # !# Procedure : Do^All^Initialisation # !# # !# This procedure performs all initialisation for the program. # !# # !# It will read the define for =prtfba_logfile and default to $0 if not # !# present, the logfile is then immediately openned so it may be used # !# for error logging. # !# # !# It then reads the startup message off $receive to avoit the startup # !# message not read errors being generated. It does nothing with the # !# startup message. # !# # !# It will read defines (as this is a well behaved program) for # !# prtfba_spl_source = the spooler supervisor and location to process # !# prtfba_target_file = the file to write fba data into # !# and report errors if not found. # !# If found will open the requested files. # !# # !# If all is well it will log a message indicating this programs # !# understanding of what the user it trying to do before returning OK. # !# # !############################################################################ Int Proc Do^All^Initialisation; Begin String Rcv^name[0:7] := ["$RECEIVE"]; Int Rcv := -2, In^File := -2, Out^Reclen; String .P1, .P2; ! Define query fields String .EXT define^name[0:23], .EXT class^name[0:15], .EXT attr^name[0:15], .EXT value^buf[0:99]; Int Value^Buf^Len, Value^Len, Real^Value^Len, Info^Request^list[0:4], Info^Reply^List[0:4]; ! Startup message structure STRUCT .^ci^startup; BEGIN INT msgcode; STRUCT default; BEGIN INT volume[0:3], subvol[0:3]; END; STRUCT infile; BEGIN INT volume[0:3], subvol[0:3], dname [0:3]; END; STRUCT outfile; BEGIN INT volume[0:3], subvol[0:3], dname [0:3]; END; STRING param[0:131]; END; !---- open our log file first and foremost, nowaited ---- !define prtfba_logfile,class map,file (default=$0) define^name ':=' ["=prtfba_logfile "]; value^buf^len := 34; ZeroFill( value^buf, 35 ); Error := DefineInfo( define^name, class^name, attr^name, value^buf, value^buf^len, value^len ); If (Error <> 0) Then Begin If (Error = 2051) Then Begin -- define name not found, setup defaults Log^File^NameLen := 2; Log^File^Name ':=' "$0" & 0; -- fall thru End Else If (Error = 2052) Then Begin -- unable to ontain file system buffer space Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OBTAIN FILE SYSTEM BUFFER SPACE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!, Completion^Code,,, Error^Text:Error^Text^Len ); Return False; End Else Begin -- programmer error Completion^Code := Fatal^Error^Code; Error^Text ':=' "INTERNAL PROGRAMMING ERROR:DEFINEINFO" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!, Completion^Code,,, Error^Text:Error^Text^Len ); Return False; End; End -- else define was found Else Begin If (class^name <> "MAP") Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL DEFINE TYPE FOR =PRTFBA_LOGFILE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!, Completion^Code,,, Error^Text:Error^Text^Len ); Return False; End; -- if OK use the values provided by the caller -- The values returned are null terminated. Log^File^Name ':=' value^buf for $MIN(value^buf^len,34) & 0; Scan Log^File^Name Until 0 -> @Ptr; Log^File^NameLen := @Ptr '-' @Log^File^Name; End; -- If we get to here, try to open the system/user event logs. Error := File_Open_( Log^File^Name:Log^File^NameLen, Log^File ); If (Error <> 0) Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OPEN " & Log^File^Name for Log^File^Namelen & ", ERROR nnn" -> @Ptr; Call Numout( Ptr[-3], Error, 10, 3 ); Error^Text^Len := (@Ptr '-' @Error^Text); Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!, Completion^Code,,, Error^Text:Error^Text^Len ); Return False; End; !==== From this point onward we have a log file so do not call abend ==== !---- Initialise Key Global Variables ---- Select^Loc := False; Select^Loc^Len := 0; !---- Open $RECEIVE and read the startup message sent ---- ! then reply to the opener process and close $RECEIVE again. ! We will not treat this program as a server so $RECEIVE is ! not required during processing. Error := File_Open_( Rcv^Name:8, Rcv,,,,, 1 !don't get open/close etc! ); If (Error <> 0) Then Begin Error^Text ':=' "UNABLE TO OPEN $RECEIVE, ERROR nnn" -> @Ptr; Call Numout( Ptr[-3], Error, 10, 3 ); Completion^Code := Fatal^Error^Code; Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( Prtfba^evt^file^open^error, Error^Text, Error^Text^Len, True ); Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!, Completion^Code,,, Error^Text:Error^Text^Len ); End; Call Read( Rcv, ^ci^startup, $len( ^ci^startup ), Count^Read ); If <> Then Begin Call Fileinfo( Rcv, Error ); If (Error <> 6) Then Begin -- not a system message Error^Text ':=' "FILE ERROR nnn ON $RECEIVE" -> @Ptr; Call Numout( Error^Text[11], Error, 10, 3 ); Completion^Code := Fatal^Error^Code; Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( Prtfba^evt^file^io^error, Error^Text, Error^Text^Len, True ); Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!, Completion^Code,,, Error^Text:Error^Text^Len ); End; -- else the startup message we will ignore End; Call File_Close_( Rcv ); !---- get all the rest of our defines now !define prtfba_spl_source,class map,file . Spool^Superdor := ???; define^name ':=' ["=prtfba_spl_source "]; value^buf^len := 34; ZeroFill( value^buf, 35 ); Error := DefineInfo( define^name, class^name, attr^name, value^buf, value^buf^len, value^len ); If (Error <> 0) Then Begin If (Error = 2051) Then Begin -- define name not found, no location defaults Completion^Code := Fatal^Error^Code; Error^Text ':=' "NO DEFINE FOR =PRTFBA_SPL_SOURCE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^no^required^define, Error^Text, Error^Text^Len, True ); Return False; End Else If (Error = 2052) Then Begin -- unable to ontain file system buffer space Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OBTAIN FILE SYSTEM BUFFER SPACE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^no^buffer^space, Error^Text, Error^Text^Len, True ); Return False; End Else Begin -- programmer error Completion^Code := Fatal^Error^Code; Error^Text ':=' "INTERNAL PROGRAMMING ERROR:DEFINEINFO" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^programmer^error, Error^Text, Error^Text^Len, True ); Return False; End; End -- else define was found Else Begin If (class^name <> "MAP") Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL DEFINE TYPE FOR =PRTFBA_SPL_SOURCE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; -- if OK use the values provided by the caller -- split the . into its parts -- Scan won't work on extended memory so move data locally S^Buffer ':=' value^buf for value^buf^len & 0; Scan S^Buffer Until 0 -> @Ptr; Real^Value^Len := @Ptr '-' @S^Buffer; Scan S^Buffer UNTIL "." -> @Ptr; If $CARRY Then Begin -- not a valid file name folks Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL FILE VALUE FOR =PRTFBA_SPL_SOURCE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; If (Ptr[1] = "$") Then Begin -- assume \sys.$. @Ptr := @Ptr + 1; Scan Ptr UNTIL "." -> @Ptr; If $CARRY Then Begin -- not a valid file name folks Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL FILE VALUE FOR =PRTFBA_SPL_SOURCE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; End; Spool^Supervisor ':=' S^Buffer for (@Ptr '-' @S^Buffer) & 0; Spool^Name^Len := (@Ptr '-' @S^Buffer); @Ptr := @Ptr + 1; Select^Loc^Len := Real^Value^Len '-' (@Ptr '-' @S^Buffer); Loc^Key ':=' Ptr For Select^Loc^Len; End; -- If we get to here, try to open the spooler supervisor. If NOT Open^Spool^Supervisor Then Return False; !define prtfba_target_file,class map, file define^name ':=' ["=prtfba_target_file "]; value^buf^len := 34; ZeroFill( value^buf, 35 ); Error := DefineInfo( define^name, class^name, attr^name, value^buf, value^buf^len, value^len ); If (Error <> 0) Then Begin If (Error = 2051) Then Begin -- define name not found, no target file defaults Completion^Code := Fatal^Error^Code; Error^Text ':=' "NO DEFINE FOR =PRTFBA_TARGET_FILE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^no^required^define, Error^Text, Error^Text^Len, True ); Return False; End Else If (Error = 2052) Then Begin -- unable to ontain file system buffer space Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OBTAIN FILE SYSTEM BUFFER SPACE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^no^buffer^space, Error^Text, Error^Text^Len, True ); Return False; End Else Begin -- programmer error Completion^Code := Fatal^Error^Code; Error^Text ':=' "INTERNAL PROGRAMMING ERROR:DEFINEINFO" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^programmer^error, Error^Text, Error^Text^Len, True ); Return False; End; End -- else define was found Else Begin If (class^name <> "MAP") Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL DEFINE TYPE FOR =PRTFBA_TARGET_FILE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; -- if OK use the values provided by the caller -- split the . into its parts Disk^File^Name ':=' value^buf for value^buf^len & 0; Scan Disk^File^Name until 0 -> @Ptr; Disk^File^Namelen := @Ptr '-' @Disk^File^Name; End; -- If we have a file name lets check the record length on it. Info^Request^List[0] := 43; -- request logical record length Error := File_Getinfolistbyname_( Disk^File^Name:Disk^File^Namelen, Info^Request^List, 1, Info^Reply^List, 5); If (Error <> 0) Then Begin -- If we get to here, try to open the output file now. Completion^Code := Fatal^Error^Code; Error^Text ':=' "GETINFOLIST ACCESS ERROR ON " & Disk^File^Name for Disk^File^Namelen & ", ERROR nnn" -> @Ptr; Call Numout( Ptr[-3], Error, 10, 3 ); Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^file^access^error, Error^Text, Error^Text^Len, True ); Return False; End; If (Info^Reply^List[0] <> 133) Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "LRECL OF " & Disk^File^Name for Disk^File^Namelen & " IS NOT 133 BYTES, UNUSEABLE FILE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^file^lrecl^error, Error^Text, Error^Text^Len, True ); Return False; End; Error := File_Open_( Disk^File^Name:Disk^File^NameLen, Disk^File ); If (Error <> 0) Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OPEN " & Disk^File^Name for Disk^File^Namelen & ", ERROR nnn" -> @Ptr; Call Numout( Ptr[-3], Error, 10, 3 ); Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^file^open^error, Error^Text, Error^Text^Len, True ); Return False; End; !define prtfba_spooler_action,class map, file $HOLD define^name ':=' ["=prtfba_spooler_action "]; value^buf^len := 34; ZeroFill( value^buf, 35 ); Error := DefineInfo( define^name, class^name, attr^name, value^buf, value^buf^len, value^len ); If (Error <> 0) Then Begin If (Error = 2051) Then Begin -- define name not found, use defaults Spooler^Final^Action := Delete^Job; End Else If (Error = 2052) Then Begin -- unable to ontain file system buffer space Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OBTAIN FILE SYSTEM BUFFER SPACE" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^no^buffer^space, Error^Text, Error^Text^Len, True ); Return False; End Else Begin -- programmer error Completion^Code := Fatal^Error^Code; Error^Text ':=' "INTERNAL PROGRAMMING ERROR:DEFINEINFO" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^programmer^error, Error^Text, Error^Text^Len, True ); Return False; End; End -- else define was found Else Begin If (class^name <> "MAP") Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL DEFINE TYPE FOR =PRTFBA_SPOOLER_ACTION" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; -- if OK use the values provided by the caller -- split the . into its parts S^Buffer ':=' value^buf for value^buf^len & 0; If (S^Buffer[0] = "\") Then Begin Scan S^Buffer Until "." -> @Ptr; @Ptr := @Ptr '+' 1; End Else @Ptr := @S^Buffer; If (Ptr = "$HOLD") Then Spooler^Final^Action := Hold^Job Else Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ILLEGAL FILE VALUE FOR =PRTFBA_SPOOLER_ACTION" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^bad^required^define, Error^Text, Error^Text^Len, True ); Return False; End; End; -- Ok, say we are starting Error^Text ':=' "RQST: " & Spool^Supervisor for Spool^Name^Len & "." & Loc^Key for Select^Loc^Len & "--->" & Disk^File^Name for Disk^File^Namelen -> @Ptr; Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( prtfba^evt^pgm^start, Error^Text, Error^Text^Len, False ); -- OK, all done Return True; End; ! end of int proc Do^All^Initialisation ?Page "Process^All^Matching^Jobs" !############################################################################ !# # !# Procedure : Process^All^Matching^Jobs # !# # !# This proc checks all the jobs under the user selected spool supervisor # !# to see if they are at a location matching those the user wishes us to # !# copy to disk. # !# If any matching jobs are found they will be copied to out disk file. # !# # !# Notes: Uses values in the GLOBAL Error variable. Ensure that when we # !# come back with an all-ok situation we reset this to zero # !# (as error statuses are used to detect end-of-peruse-output etc. # !# so error will be non-zero after a sucessful print). # !# # !############################################################################ Proc Process^All^Matching^Jobs; Begin Int New^Job := -1, Local^Loc^Key^Len; String .P1, .P2, Local^Loc^Key[0:15], Local^Buffer[0:16]; Struct .Spooler^Job( Spooler^Job^Def ) = SpoolBuff; Int SubProc Matches^Search^Criteria; Begin !If we have a search location, check it and return on no match. If (Local^Loc^Key <> Spooler^Job.Location.Group For Local^Loc^Key^Len) Then Return False; !If we reach here it matches the search criteria. Return True; End; -- location is as #xxx.yyy, spooler checks are against #xxx yyy -- so expand it out. Local^Loc^Key ':=' " "; Local^Buffer ':=' Loc^Key for Select^Loc^Len & 0; -- 0 to stop scan @P1 := @Local^Buffer; Scan P1 Until "." -> @P2; If $CARRY Then Begin Local^Loc^Key ':=' P1 For Select^Loc^Len; Local^Loc^Key^Len := Select^Loc^Len; End Else Begin Local^Loc^Key ':=' P1 for $MIN((@P2 '-' @P1),8) & " "; @P2 := @P2 + 1; Local^Loc^Key^Len := Select^Loc^Len '-' (@P2 '-' @P1); Local^Loc^Key[8] ':=' P2 for $MIN(Local^Loc^Key^Len,8); Local^Loc^Key^Len := $MIN((Local^Loc^Key^Len+8),16); End; !We wish to search the entire spooler for jobs matching the location we want. Spooler^Job.Number := 0; Error := 0; While Not Error Do Begin If (Do^Spooler^Query( 2, 1 ) AND Matches^Search^Criteria) Then Begin -- A matching job has been found. !Get the page size info and store the job numbers. ! states are, 0 = ? (crash-closed), 1 = open, 2 = ready, 3 = held, 4 = printing If (Spooler^Job.State = 2) Then Begin -- job is in ready Job^Table[JobEntryCount] := Spooler^Job.Number; JobEntryCount := JobEntryCount + 1; If Not Access^Spooler^Datafile Then Return; -- say we are doing something Error^Text ':=' "JOB nnnnn OPENED" -> @Ptr; Call Numout(Error^Text[4], Spooler^Job.Number, 10, 5); Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( prtfba^evt^job^started, Error^Text, Error^Text^Len, False ); If NOT List^All^Job^Pages Then Begin -- unable to process job Error^Text ':=' "ERROR PROCESSING SPOOLER JOB nnnnn" -> @Ptr; Call Numout(Ptr[-5], Spooler^Job.Number, 10, 5); Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( Prtfba^evt^spldata^bad^error, Error^Text, Error^Text^Len, True ); Return; End Else Begin -- else copied to disk Error^Text ':=' "JOB nnnnn PROCESSED OK" -> @Ptr; Call Numout(Error^Text[4], Spooler^Job.Number, 10, 5); Error^Text^Len := @Ptr '-' @Error^Text; Call Write^Event^Message( prtfba^evt^job^completed, Error^Text, Error^Text^Len, False ); -- THIS MUST BE DONE (or only one job is processed) Error := 0; -- reset the global error value End; End; !notes: the Spooler^Job.copies is not used in version 1.00.00 End; -- Spooler^Job.Number := Spooler^Job.Number + 1; End; End; ! Proc Process^All^Matching^Jobs ?Page "Spooler/Peruse Section : Access^Spooler^Datafile" !############################################################################ !# # !# Procedure : Access^Spooler^Datafile # !# # !# This routine uses information returned from the spool supervisor to # !# set up control buffers to access the job data in the spool datafile. # !# The spool datafile will be opened shared, the routine then sets up a # !# print control buffer and a job control buffer which will be used to # !# access the job data in the job list routines. # !# THE SPOOLBUF AREA MUST BE SETUP FOR THE CURRENT JOB. # !# # !############################################################################ Int Proc Access^Spooler^Datafile; Begin Struct .Spooler^Job( Spooler^Job^Def ) = SpoolBuff; !---- If data file has changed or is not open then open it ---- If ((Active^Data^Name <> Spooler^Job.Data^File.Volume For 12) OR (Active^Data^File < 0)) Then Begin If Active^Data^File > 0 Then !If a previous is open, close it Begin Call File_Close_( Active^Data^File ); Active^Data^File := -1; End; Active^Data^Namelen := FNameCollapse( Spooler^Job.Data^File, Active^Data^Name ); Error := File_Open_( Active^Data^Name:Active^Data^Namelen, Active^Data^File, 1 !read only!, 0 !shared! ); !as shared, sync 1 If Error Then Begin !Open failed Completion^Code := Fatal^Error^Code; Error^Text ':=' "ERROR-UNABLE TO OPEN PRINT DATA FILE - ERROR nnn" -> @Ptr; Error^Text^Len := (@Ptr '-' @Error^Text); Call Numout( Ptr[-3], Error, 10, 3 ); Call Write^Event^Message( Prtfba^evt^spldata^open^error, Error^Text, Error^Text^Len, True ); Return False; End; End; !If data file changed !---- If we can access the data file then set up print control buffer ---- Error := Spoolerequest2( Spool, Spooler^Job.Number, JobPrintBuff ); If Error <> 0 Then Begin Call Spooler^Error( Error ); Return False; End; !---- If print control buffer was set up then set up Job control buff ---- ! Note: Needs printer control buff to do this Error := PrintStart2( JobBuff, JobPrintBuff, Active^Data^File ); If Error <> 0 Then Begin Call Spooler^Error( Error ); Return False; End; Return True; !At last we have completed it. End; !End int proc Access^Spooler^Datafile ?Page "Spooler/Peruse Section : Open^Spool^Supervisor" !############################################################################ !# # !# Procedure : Open^Spool^Supervisor # !# # !# This routine is called to open a remote spool supervisor process. # !# It will display information about the supervisor process if the open # !# is successfull. # !# # !############################################################################ Int Proc Open^Spool^Supervisor; Begin Error := File_Open_( Spool^Supervisor:Spool^Name^Len, Spool ); If (Error <> 0) Then Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "UNABLE TO OPEN SPOOLER SUPERVISOR " & Spool^Supervisor for Spool^Name^Len & ": ERROR nnn" -> @Ptr; Error^Text^Len := @Ptr '-' @Error^Text; Call Numout( Ptr[-3], Error, 10, 3 ); Write^Event^Message( Prtfba^evt^file^open^error, Error^Text, Error^Text^Len, True); Spool := -2; Return False; End; Return True; End; !End of int proc open^spool^supervisor ?Page "Spooler/Peruse Section : List^One^Job^Page" !############################################################################ !# # !# Procedure : List^One^Job^Page # !# # !# This proc will list one page of a report from a spooled job into our # !# disk file. # !# It is called for each page from List^All^Job^Pages. # !# # !# It returns a few of the errors to the caller to handle. # !# # !############################################################################ Int Proc List^One^Job^Page; Begin Int Bytes^Read, Error, Job^Page^Id; String Special^Code := [" "]; String .Data^Ptr := @JobDataBuff '<<' 1; Error := 0; Job^Page^Id := JobPage; While Not Error Do Begin Error := PrintRead( JobBuff, JobDataBuff, 900, Bytes^Read, Job^Page^Id ); If < Then Return 0; !Assume end of page. If Error Then Begin If ((Error = %12000) Or (Error = %12001)) !End of file or end of copy Then Return Error Else If Error = %12002 Then Begin !Invalid data file format Completion^Code := Fatal^Error^Code; Error^Text ':=' "ERROR-INVALID DATA FILE FORMAT" -> @Ptr; Error^Text^Len := @Ptr '-' @Error^Text; Write^Event^Message( Prtfba^evt^spldata^bad^error, Error^Text, Error^Text^Len, True ); Return Error; End Else If Error = %12003 Then Begin !Control found If ((JobDataBuff[0] = 1) !Not a form feed so carry on AND (JobDataBuff[1] = 0)) Then Begin !A form feed, write our special codes Special^Code := "1"; -- form feed code End; Error := 0; !Not a form feed, keep going End Else If Error = %12004 Then Error := 0 !Setmode found, ignore Else If Error = %12005 Then Error := 0 !Controlbuf found, ignore Else Begin Completion^Code := Fatal^Error^Code; Error^Text ':=' "ERROR-UNKNOWN PERUSAL ERROR: %nnnnnn" -> @Ptr; Error^Text^Len := @Ptr '-' @Error^Text; Call Numout( Ptr[-6], Error, 7, 6 ); Write^Event^Message( Prtfba^evt^spldata^read^error, Error^Text, Error^Text^Len, True ); Return Error; End; End !Then Else Begin S^Buffer ':=' Special^Code for 1 & Data^Ptr For Bytes^Read -> @Ptr; ! *** parse the output for all the line breaks we need ??? *** If Write^To^Disk^File( Buffer, Bytes^Read + 1 ) Then Begin Special^Code := " "; -- reset in case we had a form feed End Else Return 999; -- emulate a special error End; !Else Job^Page^Id := 0; -- indicate we wish to carry on getting data End; !While Return Error; End; ! End proc list^one^job^page ?Page "Spooler/Peruse Section : List^All^Job^Pages" !############################################################################ !# # !# Procedure : List^All^Job^Pages # !# # !# This procedure will list all the pages spooled in the job datafile. # !# It does so by repeatedly calling list^one^job^page until an end of # !# job error is returned from list^one^job^page. # !# # !# It returns true is all was OK, false if we had a problem. # !# # !############################################################################ Int Proc List^All^Job^Pages; Begin Error := 0; JobPage := 1; While Not Error Do Begin Error := List^One^Job^Page; If ((Error = %12000) Or (Error = %12001)) Then Return True -- end of job Else If Error = %12003 Then Begin End !Page skip Else If (Error <> 0) Then Return False -- unknown error Else Begin Error := 0; !reset error JobPage := JobPage + 1; !and move to the next page End; End; Return False; !Should not get here End; ! end int proc list^all^job^pages ?Page "Spooler/Peruse Section : Do^Spooler^Query" !############################################################################ !# # !# Procedure : Do^Spooler^Query # !# # !# This routine is called to perform I/O to the spooler supervisor. It # !# will loop until the 'request completed' code or an error is detected. # !# Error %14016 is request in progress. This may be returned a couple of # !# times depending on how busy the spooler supervisor is. # !# # !# It returns false if we get an error, true if all was OK. # !# # !############################################################################ Int Proc Do^Spooler^Query( Cmd^Code, Scan^Type ); Int Cmd^Code, Scan^Type; Begin Error := %14016; !Set to request in progress so we loop until complete While Error = %14016 Do !Loop until state is no longer 'in progress' Begin Error := SpoolerStatus2( Spool, Cmd^Code, Scan^Type, SpoolBuff ); If ((Error <> 0) AND (Error <> %14016)) Then Begin If Error <> %14006 !Not normal end of data Then Call Spooler^Error( Error ); Return False; End; End; Return True; End; ! end of int proc do^spooler^query ?Page "Spooler/Peruse Section : Delete^Spooled^Job" !############################################################################ !# # !# Procedure : Delete^Spooled^Job # !# # !# This routine will delete a job from the spooler queue file. It cannot # !# be printing at the time. # !# # !# It will hold the job, then delete it. # !# # !# It will log success/fail messages to the EMS log. # !# # !############################################################################ Proc Delete^Spooled^Job( Job^Number ); Int Job^Number; Begin ! Struct .Spooler^Job( Spooler^Buffer^Def ) = SpoolBuff; Struct .Spooler^Job( Spooler^Job^Def ) = SpoolBuff; !First ensure the spooler command buffer is set up correctly. !Get the job details again. ! Spooler^Job.Number := Job^Number; ! If NOT (Do^Spooler^Query( 2, 1 )) Then Begin ! Error^Text ':=' "UNABLE TO DELETE JOB nnnnn, DELETE MANUALLY" -> @Ptr; ! Call Numout( Error^Text[21], Job^Number, 10, 5 ); ! Error^Text^Len := @Ptr '-' @Error^Text; ! Completion^Code := Warning^Error^Code; ! Write^Event^Message( Prtfba^evt^job^purge^error, ! Error^Text, Error^Text^Len, True ); ! Return; ! End; !Hold the job first Error := SpoolerCommand( Spool, 2, Job^Number, 122 ); If Error Then Begin Call Spooler^Error( Error ); If (Spooler^Final^Action = Delete^Job) Then Begin Error^Text ':=' "UNABLE TO DELETE JOB nnnnn, DELETE MANUALLY" -> @Ptr; Call Numout( Error^Text[21], Job^Number, 10, 5 ); Error^Text^Len := @Ptr '-' @Error^Text; Completion^Code := Warning^Error^Code; Write^Event^Message( Prtfba^evt^job^purge^error, Error^Text, Error^Text^Len, True ); End Else Begin Error^Text ':=' "UNABLE TO HOLD JOB nnnnn, HOLD MANUALLY" -> @Ptr; Call Numout( Error^Text[19], Job^Number, 10, 5 ); Error^Text^Len := @Ptr '-' @Error^Text; Completion^Code := Warning^Error^Code; Write^Event^Message( Prtfba^evt^job^hold^error, Error^Text, Error^Text^Len, True ); End; Return; End; !If we only want to hold the job, we are done here If (Spooler^Final^Action <> Delete^Job) Then Begin S^Buffer ':=' "JOB nnnnn NOW HELD ON SPOOL" -> @Ptr; Call Numout(S^Buffer[4], Job^Number, 10, 5 ); Write^Event^Message( Prtfba^evt^job^held, S^Buffer, (@Ptr '-' @S^Buffer), False ); Return; End; !else delete the job Error := SpoolerCommand( Spool, 2, Job^Number, 116 ); If Error Then Begin Call Spooler^Error( Error ); Error^Text ':=' "UNABLE TO DELETE JOB nnnnn, DELETE MANUALLY" -> @Ptr; Call Numout( Error^Text[21], Job^Number, 10, 5 ); Error^Text^Len := @Ptr '-' @Error^Text; Completion^Code := Warning^Error^Code; Write^Event^Message( Prtfba^evt^job^purge^error, Error^Text, Error^Text^Len, True ); Return; End; -- else job has been deleted. S^Buffer ':=' "JOB nnnnn DELETED FROM SPOOL" -> @Ptr; Call Numout(S^Buffer[4], Job^Number, 10, 5 ); Write^Event^Message( Prtfba^evt^job^deleted, S^Buffer, (@Ptr '-' @S^Buffer), False ); End; ! End of Proc Delete^Spooled^Job ?Page "Spooler/Peruse Section : Spooler^Error" !############################################################################ !# # !# Procedure : Spooler^Error # !# # !# This procedure is called for any error returned from the spooler # !# supervisor process. It will display a message indicating the error # !# that occured. # !# # !############################################################################ Proc Spooler^Error( Error ); Int Error; Begin If ((Error > %2777) AND (Error < %3400)) Then !File error in .<8:15> Begin Error := Error.<8:15>; Error^Text ':=' "SPLERR:FILE ERROR nnn ON SUPERVISER PROCESS " & Spool^Supervisor for Spool^Name^Len -> @Ptr; Call Numout( Error^Text[18], Error, 10, 3 ); End Else If Error = %10000 Then Error^Text ':=' "SPLERR:Missing Parameter" -> @Ptr Else If Error = %10001 Then Error^Text ':=' "SPLERR:Parameter In Error" -> @Ptr Else If Error = %14000 Then Error^Text ':=' "SPLERR:Invalid Command" -> @Ptr Else If Error = %14001 Then Error^Text ':=' "SPLERR:Command Parameter Missing" -> @Ptr Else If Error = %14002 Then Error^Text ':=' "SPLERR:Command Parameter In Error or Buffer addressing Error" -> @Ptr Else If Error = %14003 Then Error^Text ':=' "SPLERR:Invalid subcommand" -> @Ptr Else If Error = %14004 Then Error^Text ':=' "SPLERR:Subcommand missing" -> @Ptr Else If Error = %14005 Then Error^Text ':=' "SPLERR:Subcommand parameter in error" -> @Ptr Else If Error = %14007 Then Error^Text ':=' "SPLERR:ENTRY DOES NOT EXIST" -> @Ptr Else If Error = %14010 Then Error^Text ':=' "SPLERR:CANNOT ADD ENTRY TO TABLES" -> @Ptr Else If Error = %14011 Then Error^Text ':=' "SPLERR:CANNOT FIND ENTRY" -> @Ptr Else If Error = %14012 Then Error^Text ':=' "SPLERR:ENTRY IN IMPROPPER STATE FOR COMMAND" -> @Ptr Else If Error = %14013 Then Error^Text ':=' "SPLERR:ENTRY IN IN USE" -> @Ptr Else If Error = %14014 Then Error^Text ':=' "SPLERR:INSUFFIECIENT AUTHORITY FOR THE COMMAND" -> @Ptr Else If Error = %14015 Then Begin Error^Text ':=' "SPLERR:" & Spool^Supervisor for Spool^Name^Len & " IS NOT A SPOOLER SUPERVISOR" -> @Ptr; End Else If ((Error > %77777) AND (Error < %107500)) Then Begin Error^Text ':=' "SPLERR:NEWPROCESS ERROR nnn" -> @Ptr; Call Numout( Ptr[-3], Error, 10, 3 ); End; Error^Text^Len := (@Ptr '-' @Error^Text); Write^Event^Message( Prtfba^evt^generic^spl^error, Error^Text, Error^Text^Len, True ); Completion^Code := Fatal^Error^Code; End; ! end of proc spooler^error ?Page "Utilities Section : Write^To^Disk^File" !############################################################################ !# # !# Procedure : Write^To^Disk^File # !# # !# This proc is called to write the line just retrieved from the spooler # !# out to the disk file. It ensures that the line is a full 133 bytes # !# so we can send a fixed record length file to MVS. # !# # !############################################################################ Int Proc Write^To^Disk^File( databuf, databuflen ); Int .databuf, databuflen; Begin Int Error, Spaces^Required; String .P1; ! Ensure we are writing fixed length 133 byte records @P1 := @databuf '<<' 1; Spaces^Required := 133 '-' databuflen; @P1 := @P1 + databuflen; If (Spaces^Required > 1) Then Blank( P1, Spaces^Required ) Else If (Spaces^Required = 1) Then P1 ':=' " "; Call Write( Disk^File, databuf, 133 ); If <> Then Begin Call Fileinfo( Disk^File, Error ); Error^Text ':=' "FILE ERROR nnn ON " & Disk^File^Name for Disk^File^Namelen -> @Ptr; Call Numout( Error^Text[11], Error, 10, 3 ); Error^Text^Len := @Ptr '-' @Error^Text; Completion^Code := Fatal^Error^Code; Call Write^Event^Message( Prtfba^Evt^File^Io^Error, Error^Text, Error^Text^Len, True ); Return False; End Else Return True; End; ! end of int proc write^to^disk^file ?Page "Utilities Section : Write^Event^Message" !############################################################################ !# # !# Procedure : Write^Event^Message # !# # !# This procedure accepts the values reformatted from user passed text # !# values with the appropriate tokens in the event buffer using the EMS # !# procedures. It then sends it out to the selected logging collector. # !# # !# note: if errors occur we just return (as if we can't write an error # !# message we can't report an error occurring here anyway). # !# # !############################################################################ PROC write^event^message( num, io^msg, io^len, emphasis ); INT num; -- event number passed by user STRING .io^msg; -- msg received at end of the wait INT io^len; -- length of the msg INT emphasis; -- indicates if critical or not BEGIN INT spi^error := 0, -- save last error for ABEND purposes size; -- length of the buffer ! ! Initialise the EMS buffer ! If (spi^error := EMSINIT( event^buf, -- event build buffer event^buf^size, -- total buffer length (bytes) our^ssid, -- ssid of reporting subsystem num, -- the event number ZSPI^TKN^MESSAGE, -- subject token code io^msg, -- event subject value io^len )) -- event subject length Then Return; ! ! Add several tokens at once ! If (spi^error := EMSADDTOKENS( event^buf, !our ssid by default!, -- token code value size ZEMS^TKN^EMPHASIS, emphasis,, ZEMS^TKN^CONSOLE^PRINT, FALSE^VAL )) Then Return; ! ! We put a TEXT token into the buffer for console and printing output. ! If we did not include a TEXT token the message ! "No Printing Directions for this Event" message would be displayed ! on the console (or by other printing distributers). ! ! I/O on took seconds to complete" evt^txt ':=' io^msg for io^len -> @sptr; If ( spi^error := EMSADDTOKENS( event^buf, -- event buffer ems^ssid, -- a foreign token needs SSID ZEMS^TKN^TEXT, -- token code evt^txt, -- string pointer ref @sptr '-' @evt^txt )) -- text size in bytes Then Return; ! ! This gets the size of the event that was built so we can send it ! to our chosen collector ! If ( spi^error := SSGETTKN( event^buf, -- event buffer ZSPI^TKN^USEDLEN, -- special SPI tpken code size )) -- size returned here Then Return; ! ! Writeread MUST be used to indicate an EMS message (write is text only) ! Call Writeread( Log^File, event^buf, size, 0 ); -- note 0 read count ! Do not bother to check completion. It it failed we will lose the message. END; ! end of procedure write^event^message