------------------------------------------------------------------------
Syntax :
Usage : <cmd> <jobname> <jobid>
OR
Usage : <cmd> <joblog dataset name>
OR
Usage : <cmd> setup
------------------------------------------------------------------------
*/
ADDRESS ISPEXEC "ISREDIT MACRO (STRING)"
ADDRESS ISREDIT "RESET"
call GetProfVar /* Get Profile variable */
call checkInput /* Does syntax checking for input */
call mainInit /* Initializes variables */
call getJobInfo /* Reads job info from the queque */
call readSource /* Reads entire input file into stem variable */
call mainProcess /* Main process */
call exitModule /* Clean up process */
return
/* Get error level environment value */
GetProfVar :
ADDRESS ISPEXEC "VGET (ERRLVL) PROFILE"
if (ERRLVL = '1' | ERRLVL = '2' | ERRLVL = '3')
then nop
else ERRLVL = '2'
return
/* Does syntax checking for input */
checkInput :
/* number of parms has to be 2 */
if (WORDS(string) ¬= 2 & WORDS(string) ¬= 1)
then do
say "Invalid Syntax:"
call syntaxShow
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'INVALID SYNTAX'
ADDRESS ISPEXEC "ISPEXEC SETMSG MSG(ISRZ001)"
exit(1)
end
/* setup error level */
if (WORDS(string) = 1 & translate(string) = "SETUP")
then do
ADDRESS ISPEXEC
"ADDPOP ROW(5) COLUMN(20)"
"DISPLAY PANEL(SHWMSGPL)"
saveRC = RC
"REMPOP"
if saveRC = 0
then do
"VPUT (ERRLVL) PROFILE"
ZEDSMSG = 'Error level 'ERRLVL
ZEDLMSG = 'Error level is set to 'ERRLVL
end
else do
ZEDSMSG = 'Error level not set'
ZEDLMSG = 'Error level setup is not completed'
end
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
exit(1)
end
if (WORDS(string) = 2 ) then do
DSFlag = 0
jobName = word(string,1)
jobId = word(string,2)
/* Check if job is on queue */
ADDRESS TSO
x = outtrap(out.) /* trap TSO command output */
"status" jobName"("jobId")"
x = outtrap('OFF')
if (pos('ON OUTPUT QUEUE',out.1) > 0) then nop
else do
say "Error : " out.1
call syntaxShow
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'RC = 16 '
ADDRESS ISPEXEC "ISPEXEC SETMSG MSG(ISRZ001)"
exit(1)
end
end
else do
DSFlag = 1
/*Eliminate the single quotes provided by the user*/
string=STRIP(String,B,"'")
jobLogName = word(string,1)
"ALLOC DA('"jobLogName"') F(JOBXXX) SHR REUSE"
if RC ¬= 0 then do
"FREE F(JOBXXX)"
say "Invalid input Dataset ("jobLogName")"
call syntaxShow
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'RC = 16 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
exit(1)
end
"FREE F(JOBXXX)"
end
return
/* Syntax to be displayed in case of major errors */
syntaxShow :
say "Usage : <cmd> <jobname> <jobid> "
say "OR"
say "Usage : <cmd> <joblog dataset name> "
say "OR"
say "Usage : <cmd> setup"
return
/* Initialize certain variables */
mainInit :
/* Used for labels */
char1 = 'A B C D E F G H I J K L M N O P Q R S T U V W X Y Z'
prev_linen = 0
/* Initialize Severe Error flags */
do i = 1 to 4
dec1.i = 1
dec2.i = 1
dec3.i = 1
cntr.i = 0
LabelList_cntr.i = 0
LabelList.i. = ""
end
return
getJobInfo :
/* write job info to a file */
if (DSFlag = 0 ) then do
call createJoblogFile
end
else do
FileName = jobLogName
end
drop X.
if (DSFlag = 0 )
then "ALLOC DA("FileName") F(JOBXXX) SHR REUSE"
else "ALLOC DA('"FileName"') F(JOBXXX) SHR REUSE"
"EXECIO * DISKR JOBXXX (STEM X. FINIS"
"FREE F(JOBXXX)"
/* If no job info then error */
maxlines = X.0
if (maxlines = 0 | DATATYPE(maxlines, W) = 0)
then do
say " Job Info Read Error (maxlines = 0)"
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'RC = 16 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
call exitModule
end
return
/* In case of input from Joblog ; create a seq file name to be used
retrieve joblog info */
CreateJoblogFile :
parse value time() with hh":"mm":"ss":"
parse value date() with dd" "mon" "yyyy
dd=right(dd,2,"0")
mm=right(mm,2,"0")
hh=right(hh,2,"0")
mm=right(mm,2,"0")
ss=right(ss,2,"0")
user=userID()
yyyy=right(yyyy,2)
dsname = user||".D"||dd||mon||yyyy||".T"||hh||mm||ss
ADDRESS TSO
"OUTPUT "jobName"("jobId") PRINT("dsname") BEGIN HOLD KEEP"
if (pos('REJECTED',out.1) > 0)
then do
say ' Problem while Accessing Joblog '
say out.1
call syntaxShow
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'RC = 16 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
call exitModule
end
FileName = dsname".OUTLIST"
/* FileName created */
return
/* Delete temporarily created seq dataset */
deleteJoblogFileName :
if (DSFlag = 0 ) then do
outTemp = outtrap(out.) /* trap TSO command output */
ADDRESS TSO "DELETE "FileName" PURGE"
outTemp = outtrap('OFF')
end
return
/* Delete temporarily created seq dataset */
readSource:
ADDRESS ISPEXEC "ISREDIT (lend) = LINENUM .ZLAST"
ADDRESS ISPEXEC "ISREDIT (lstart) = LINENUM .ZFIRST"
j=0
drop in_line.
do i = lstart to lend
ADDRESS ISPEXEC "ISREDIT (var) = LINE (i)"
pres_line = var
j = j+1
in_line.j = translate(pres_line)
end
in_max = j
return
mainProcess :
cntr_occur = 0
LineIdN = 0
/* Compiler and Precompiler options flags
and counters */
drop FlagOption.
FlagOptionCntr = 0
drop SourceOption.
SourceOptionCntr = 0
drop SqlOption.
SqlOptionCntr = 0
PosPreComp = -1
PosComp = -1
/* Precompile error flags and counters */
PreLine = 0
Precomp1 = 0
PreErrorCnt = 0
PreErrorStr.= ""
PreErrorLn. = ""
/* Translate error flags and counters */
TransErrorCnt = 1
TransErrorStr.= "Translator Errors Present :"
/* Search Job Info */
do i = 1 to maxlines
dsnt = substr(X.i,1,4)
t2 = substr(X.i,2)
t1 = strip(translate(word(t2,1)))
/* Check for Precompiler errors */
if (Precomp1 < 2 & pos('DSN', dsnt) > 0 & ,
(word(t2,2) = 'E' | word(t2,2) = 'S'))
then do
Precomp1 = 1
PreErrorCnt = PreErrorCnt + 1
PreErrorStr.PreErrorCnt = strip(X.i)
temp = FIND(t2,'LINE')
PreErrorLn.PreErrorCnt = word(t2,temp+1)
end
/* Check for translator */
if ( pos('DFH', dsnt) > 0 & word(t2,2) = 'E' & ,
DATATYPE(word(t2,3),W) = 1)
then do
TransErrorCnt = TransErrorCnt + 1
TransErrorStr.TransErrorCnt = strip(X.i)
end
/* Check for Compiler Options */
tempStr1= word(t2,1)
if(pos('FLAG(',tempStr1) > 0 )
then do
FlagOptionCntr = FlagOptionCntr + 1
FlagOption.FlagOptionCntr = tempStr1
end
if(pos('SOURCE',tempStr1) > 0 )
then do
SourceOptionCntr = SourceOptionCntr + 1
SourceOption.SourceOptionCntr = tempStr1
end
if(pos('SQL',tempStr1) > 0 )
then do
SqlOptionCntr = SqlOptionCntr + 1
SqlOption.SqlOptionCntr = tempStr1
end
if (PreErrorCnt > 0)
then do
tempStr = substr(t2,1,20)
if (pos('DB2 SQL PRECOMPILER',tempStr)>0) then do
if Precomp1 = 2 then do
PreLine = i
leave i
end
Precomp1 = 2
end
end
else do
if (t1 = 'LINEID') then do
LineIdN = i
leave i
end
end
end
/* Call required modules based on error*/
if ( TransErrorCnt > 1) then call transCheck
else if (PreErrorCnt > 0)
then call preCompCheck /* For precompile errors */
else call compCheck /* For Normal Compile errors */
return
/* For Normal Compile errors */
compCheck :
/* Joblog missing error check */
if LineIdN = 0
then do
say "Job Listing not present in Compile output"
ZEDSMSG = 'RC = 16 '
ZEDLMSG = 'RC = 16 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
call exitModule
end
JoblogN = LineIdN + 1
SourceN = 1
sourceEOF = 0
/* Loop thru' entire joblog */
do jobLogN = (LineIdN + 1) to maxlines
/* Skip commented lines in source */
if (pos('*',in_line.SourceN) = 7)
then do
do while (pos('*',in_line.SourceN) = 7)
SourceN = SourceN + 1
end
end
/* Skip commented lines in Joblog */
if (pos('*',X.JoblogN) = 25)
then do
do while (pos('*',X.JoblogN) = 25)
JoblogN = JoblogN + 1
end
end
jobLogIn = translate(X.JoblogN)
/* Skip certain lines in source */
if ( (pos('EJECT',in_line.SourceN) > 0) ,
| (pos('PROCEDURE DIVISION.',in_line.SourceN) > 0) ,
| (pos('DATE-COMPILED.',in_line.SourceN) > 0) ,
| (pos(' SKIP1 ',in_line.SourceN) > 0) )
then SourceN = SourceN + 1
/* If beyond source line then set flag */
if (SourceN > in_max) then sourceEOF = 1
/* Skipped translated lines */
if (pos('INSERTED BY TRANSLATOR',jobLogIn) > 0)
then do
JoblogN = JoblogN + 1
SourceN = SourceN + 1
iterate JoblogN
end
/* Skip lines without line numbers
in joblog */
LineNum1 = substr(jobLogIn,4,6)
if (DATATYPE(LineNum1,W) = 0) then iterate JoblogN
/* Extract required lines */
LineIn = strip(substr(in_line.SourceN,01,72))
JobIn = strip(substr(jobLogIn ,19,72))
/* Continue if joblog and source match */
if (LineIn = JobIn)
then do
SourceN = SourceN + 1
iterate JoblogN
end
/* Skip exec's - since they are
translated */
if ((pos(' EXEC',in_line.SourceN) > 0) )
then do
do until (pos('END-EXEC',in_line.SourceN) > 0)
SourceN = SourceN + 1
end
SourceN = SourceN + 1
iterate JoblogN
end
/* Skip copy's - since they are
expanded */
if (pos('COPY',in_line.SourceN) > 0)
then do
SourceN = SourceN + 1
iterate JoblogN
end
/* Check for presence of compile error
Eye Catcher */
if (pos(' IGY',jobLogIn) > 0)
then do
wordA = WORD(jobLogIn,1)
if (pos('==',wordA) > 0 )
then do
word1 = WORD(jobLogIn,2)
call getSeverity /* Get error severity */
call extractErr /* Extract and display error */
call updateEOJCounters /* Update End of Job counters*/
cntr_occur = cntr_occur + 1
end
iterate JoblogN
end
/* In case of mismatch check joblog line
with next lines of source. If match
found update source counter */
SourceT = SourceN
do iTemp = 1 to 10
SourceT = SourceT + 1
do while (pos('*',in_line.SourceT) = 7)
SourceT = SourceT + 1
end
LineInNext = strip(substr(in_line.SourceT,01,72))
if (LineInNext = JobIn) then do
SourceN = SourceT + 1
iterate JoblogN
end
end
end
/* Incomplete Joblog Error */
if (sourceEOF = 0)
then do
linen = 0
msg = "*---------*---------*---------*---------*---------*"
call displayMsg
msg = " Incomplete Joblog"
call displayMsg
msg = "*---------*---------*---------*---------*---------*"
call displayMsg
end
return
/* Write EOJ Counters */
writeEOJCounters :
linen = 0
l_RC = 0
do j = 2 to 1 by -1
if ( j = 1 ) then msg1 = 'E'
else if ( j = 2 ) then msg1 = 'W'
else if ( j = 3 ) then msg1 = 'P'
msg = msg1 ": total :" cntr.j
if LabelList_cntr.j > 0
then do
t1 = LabelList_cntr.j
Slabel = LabelList.j.1
Elabel = LabelList.j.t1
msg =msg "(."Slabel"-."Elabel")"
end
call displayMsg
if (j = 1 & cntr.j > 0 ) then l_RC = 8
if (j = 2 & cntr.j > 0 ) then l_RC = 4
if (j = 3 & cntr.j > 0 ) then l_RC = 4
end
msg = "Number of messages : " cntr_occur
call displayMsg
ZEDSMSG = 'RC =' l_RC
ZEDLMSG = 'RC =' l_RC
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
/* Compiler option mismatch error */
if (pos('NOSOURCE',SourceOption.SourceOptionCntr) > 0 )
then do
msg = "*---------------------------------------------------------*"
call displayMsg
msg = " Required Source Option : SOURCE"
call displayMsg
msg = " Current Source Option :" SourceOption.SourceOptionCntr
call displayMsg
msg = " Source Compiler option not matching with expected options"
call displayMsg
msg = "*---------------------------------------------------------*"
call displayMsg
end
if (pos('FLAG(I,I)',FlagOption.FlagOptionCntr) = 0 |,
FlagOptionCntr = 0 )
then do
msg = "*-------------------------------------------------------*"
call displayMsg
msg = " Required Flag Option : FLAG(I,I)"
call displayMsg
msg = " Current Flag Option :" FlagOption.FlagOptionCntr
call displayMsg
msg = " Flag Compiler option not matching with expected options"
call displayMsg
msg = "*-------------------------------------------------------*"
call displayMsg
end
return
/* Get severity of compiler error */
getSeverity :
if(pos('-S',word1) > 0 | pos('-E',word1) > 0 )
then SevereInd = 'E'
else SevereInd = 'W'
return
/* Extract complete error message */
extractErr :
i_local = JoblogN
/* Get complete msg */
MsgDispVar = ""
do j=i_local to (i_local + 6)
t1 = translate(strip(X.j))
t2 = translate(X.j)
if ( (pos('IBM COBOL',t1) > 0) | (pos('LINEID',t1) > 0) )
then iterate j
if length(t1) < 2 then leave j
MsgDispVar = MsgDispVar" "substr(t2,2)
end
/* Parse error msg in lengths of 70
characters & display */
Strk = SPACE(MsgDispVar)
linen = SourceN
call displayBigLine
/* make sure not to overwrite labels */
if (SevereInd = 'E' ) then ptr = 1
else ptr = 2
if (prev_linen ¬= linen | prev_SeverePtr > ptr)
then do
if (prev_linen = linen)
then do
t1 = prev_SeverePtr
LabelList_cntr.t1 = LabelList_cntr.t1 - 1
end
/* make sure not to overwrite labels */
LabelList_cntr.ptr = LabelList_cntr.ptr + 1
ptr1 = LabelList_cntr.ptr
prev_SeverePtr = ptr
prev_linen = linen
linen = linen - 1
/* Generate label at error line */
call generateLabel
/* Set label at error line */
if linen =0 then lineT = 1
else lineT = linen
ADDRESS ISPEXEC "ISREDIT LABEL" lineT " = ."label1" 0 "
LABELLIST.ptr.ptr1 = label1
end
/* Display Message at top based on error
level indicator */
if ( ERRLVL = '2' |,
( ERRLVL = '1' & SevereInd ='E'))
then do
/* Parse error msg in lengths of 70
characters & display */
MsgDispVar = "(."LABELLIST.ptr.ptr1")" MsgDispVar
Strk = SPACE(MsgDispVar)
linen = 1
call displayBigLine
end
return
/* Update End of Job counters */
updateEOJCounters :
if SevereInd = 'P' then ptr = 3
else if SevereInd = 'E' then ptr = 1
else ptr = 2
cntr.ptr = cntr.ptr + 1
return
/* Generate labels at places of error / warnings */
generateLabel :
if SevereInd = 'P' then ptr = 3
else if SevereInd = 'E' then ptr = 1
else ptr = 2
l1 = word(char1,dec1.ptr)
l2 = word(char1,dec2.ptr)
l3 = word(char1,dec3.ptr)
label1 = SevereInd||l1||l2||l3
dec3.ptr = dec3.ptr + 1
if ( dec3.ptr = 25 )
then do
dec3.ptr = 1
dec2.ptr = dec2.ptr + 1
if ( dec2.ptr = 25 )
then do
dec2.ptr = 1
dec1.ptr = dec1.ptr + 1
end
end
return
/* Display messages after given line number (linen - line number) */
displayMsg :
ADDRESS ISPEXEC "ISREDIT LINE_AFTER (linen) = MSGLINE (msg)"
return
/* Display messages before given line number (linen - linenumber) */
displayMsgBefore :
if linen = 0 then linenDm = 1
else linenDM = linen
ADDRESS ISPEXEC "ISREDIT LINE_BEFORE (linenDM) = MSGLINE (msg)"
return
/* Check for precompile errors */
preCompCheck :
SevereInd = 'P'
PreErrorCntI = 1
SourceN = 1
do JoblogN = PreLine to maxlines
/* Skip certain lines in source */
if (pos('EJECT',in_line.SourceN) > 0) then SourceN = SourceN + 1
if (pos('PROCEDURE DIVISION.',in_line.SourceN) > 0)
then SourceN = SourceN + 1
if (pos('DATE-COMPILED.',in_line.SourceN) > 0)
then SourceN = SourceN + 1
if (pos('DB2 SQL PRECOMPILER',X.JoblogN) > 0)
then iterate JoblogN
/* If beyond source line then exit */
if (SourceN > in_max) then leave JoblogN
if (pos('INSERTED BY TRANSLATOR',X.JoblogN) > 0)
then do
JoblogN = JoblogN + 1
SourceN = SourceN + 1
iterate JoblogN
end
/* Skip lines without line numbers
in joblog */
LineNum1 = substr(X.JoblogN,4,7)
if (DATATYPE(LineNum1,W) = 0) then iterate JoblogN
/* Display error at proper place */
if (LineNum1 > PreErrorLn.PreErrorCntI) then do
linen = SourceN
Strk = PreErrorStr.PreErrorCntI
call displayBigLine
call generateLabel
linen = SourceN - 1
/* Set label at error line */
if linen =0 then lineT = 1
else lineT = linen
ADDRESS ISPEXEC "ISREDIT LABEL" lineT " = ."label1" 0 "
LabelList_cntr.4 = LabelList_cntr.4 + 1
t1 = LabelList_cntr.4
LabelList.4.t1 = label1
call updateEOJCounters
PreErrorCntI = PreErrorCntI + 1
if (PreErrorCntI > PreErrorCnt) then leave JoblogN
end
LineIn = translate(strip(substr(in_line.SourceN,01,72)))
JobIn = translate(strip(substr(X.JoblogN ,16,72)))
if (LineIn = JobIn)
then do
SourceN = SourceN + 1
iterate JoblogN
end
if (pos('EXEC',in_line.SourceN) > 0)
then do
do until (pos('END-EXEC',in_line.SourceN) > 0)
SourceN = SourceN + 1
end
SourceN = SourceN + 1
iterate JoblogN
end
if (pos('COPY',in_line.SourceN) > 0)
then do
SourceN = SourceN + 1
iterate JoblogN
end
end
linen = 0
msg = " total : " PreErrorCnt
t1 = LabelList_cntr.4
Slabel = LabelList.4.1
Elabel = LabelList.4.t1
msg =msg "(."Slabel"- ."Elabel")"
call displayMsg
msg = " Precompile Errors Found "
call displayMsg
ZEDSMSG = 'RC = 12 '
ZEDLMSG = 'RC = 12 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
return
/* Display big line by splitting into multiple lines
maxk - maximum characters per page
Strk - input lengthy string that needs to be displayed */
displayBigLine :
maxk = 70
lenk = length(Strk)
cntk = (lenk % maxk)
cntj = 1
endj = 0
drop msgStr.
msgStrCntr = 0
do cntj = 1 to cntk
startj = (cntj-1) * maxk + 1
endj = maxk
msg = substr(Strk,startj,endj)
msgStrCntr = msgStrCntr + 1
msgStr.msgStrCntr = msg
end
startj = (cntk * maxk) + 1
msg = substr(Strk,startj)
msgStrCntr = msgStrCntr + 1
msgStr.msgStrCntr = msg
if linen > in_max
then do
linen = in_max
do cntj = msgStrCntr to 1 by -1
msg = msgStr.cntj
call displayMsg
end
end
else do
do cntj = 1 to msgStrCntr
msg = msgStr.cntj
call displayMsgBefore
end
end
return
/* Write translator error o/p */
transCheck :
linen = 1
do i_T = 1 to TransErrorCnt
Strk = SPACE(TransErrorStr.i_T)
call displayBigLine
end
ZEDSMSG = 'RC = 12 '
ZEDLMSG = 'RC = 12 '
ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
return
/* Clean up Processes */
exitModule:
call writeEOJCounters
call deleteJoblogFileName
exit(1)
return
/*--------------------------------------------------------------------*/
/*---------------End Of Program---------------------------------------*/
/*--------------------------------------------------------------------*/
|
