DELETE and DEFINE AUTOMATION
/* Rexx */
/* trace all */
/*
Purpose : To give proper override for del/def statements
How to use : After building/modifing the JCL (job), just go
inside the job and give 'JJ'. Later type
'md9999' to make them display, then type the
command 'deldef' in the command line.
*/
ADDRESS ISREDIT
s=0
DlDf = 'NO'
"MACRO"
/*---------------- below code is to capture JCL part ---------------*/
/*------------------ which will be re-written later ----------------*/
cnt=0
"ISREDIT (lastl) = LINENUM .ZLAST"
do curr=1 to lastl
"ISREDIT (datal) = LINE" Curr
if substr(datal,1,2) = "//" then
do
if substr(datal,1,25) = "// " then
do
end
else
do
cnt=cnt+1
if index(datal,"&") \= 0 then
do
datal= translate(datal,"›","&")
y.cnt=datal
end
y.cnt=datal
end
end
if substr(datal,1,2) = "/*" then
do
cnt=cnt+1
y.cnt=datal
end
end
/*--------------------- find job name ----------------------------*/
"f all '//' 1"
"ISREDIT (currline) = LINE .ZCSR"
parse var currline '//' jobname " " rest
/*--------------------- find job sub region ----------------------*/
"f all ' n='"
"ISREDIT (currlin1) = LINE .ZCSR"
parse var currlin1 some ' N=' subreg " " rest1
if subreg= '0' then
do
call Rebuild_JCL
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
if subreg = ' ' then
do
"f all ' db='"
"ISREDIT (currlin2) = LINE .ZCSR"
parse var currlin2 some ' DB=' subreg " " rest2
end
if subreg= '0' then
do
call Rebuild_JCL
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
/*--------------------- find job region ---------------------------*/
"f all ' HL1='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HL1=' reg " " rest2
if substr(reg,3,1) \= '2' then
"f next ' HL1='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HL1=' reg " " rest2
if reg= ' ' then
do
"f all ' HLX='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HLX=' reg " " rest2
if substr(reg,3,1) \= '2' then
"f next ' HLX='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HLX=' reg " " rest2
end
if reg= 'XP2' then
do
"f all '//' 1"
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
/*----- find all the Jobsteps, Procsteps and PR2s with del/def -----*/
"x all"
"f all '//jstep'"
"f all '//pstep'"
"f all '2.STD.PARMLIB2('"
"del all x"
"ISREDIT (lastline) = LINENUM .ZLAST"
If lastline \= 0 then
Do
Do Curr=1 TO lastline
"ISREDIT (dataline) = LINE" Curr
DlDf = 'No'
if index(dataline,'JSTEP') \= 0 then
do
parse var dataline '//'jstep' 'some0
end
if index(dataline,'PSTEP') \= 0 then
do
parse var dataline '//'pstep' 'some0
end
if index(dataline,'2.STD.PARMLIB2(') \= 0 then
do
parse var dataline '--'ddname' 'some 'DSN='mem","some2
parse var dataline '--'other','
call validate_parm2_member
end
if DlDf = 'Yes' then
do
override=jstep³³'.'³³pstep³³'.'³³other
s=s+1
ov.s=override
parse var override before 'DSN=' lib '(' memname ')'
subreg1=substr(memname,2,1)
if datatype(subr1,'N') then
do
if subr1\='0' then
memname1=substr(memname,1,1)³³'0'³³substr(memname,3,6)
else
memname1=memname
end
else
memname1=memname
/*if subreg1\='0' then
memname1=substr(memname,1,1)³³'0'³³substr(memname,3,6)
else
memname1=memname */
memname1=strip(memname1)
inpds=lib³³'('³³memname1³³')'
re=substr(reg,2,1)
outpds='XT2.SMS.'³³re³³'.PARMLIB2.R'³³subreg³³'('³³memname³³')'
finpds='XT2.SMS.'³³re³³subreg³³'.PARMLIB2('³³memname³³ ')'
parse var finpds pdsname '(' oth
ADDRESS TSO
"Alloc Fi(DDIn) da('"inpds"') shr"
"Alloc Fi(DDOut) da('"outpds"') shr"
Do Forever
"ExecIO 1 DiskR DDIn" /* Read a disk record*/
If RC = 0 then do /* Not end of file */
"ExecIO 1 DiskW DDOut" /* Write a disk rec */
End
Else Do
"ExecIO 0 DiskR DDIn (Finis" /* Close the input file */
"ExecIO 0 DiskW DDOut (Finis" /* Close the output file */
Leave
End
End
"Free Fi(DDIn,DDOut)"
srchstng=reg³³'.sms.'
ADDRESS TSO
"Alloc Fi(DDUp) da('"outpds"') OLD"
"EXECIO * DISKR DDUP (STEM P1. FINIS)"
Do I=1 to P1.0
Record=P1.I
if index(Record,'.SMS.') = 0 then
Do
R1.I=Record
End
Else
do
parse var Record brest '.SMS.' regchg '.' arest
regchg=substr(regchg,1,4)³³subreg
Record=brest³³'.SMS.'³³regchg³³'.'³³arest
R1.I=Record
End
End
R1.0=P1.0
"EXECIO * DISKW DDUp (STEM R1. FINIS)"
"FREE FI(DDup)"
ADDRESS TSO
"Alloc Fi(DDIn) da('"outpds"') shr"
"Alloc Fi(DDOut) da('"finpds"') shr"
Do Forever
"ExecIO 1 DiskR DDIn" /* Read a disk record*/
If RC = 0 then do /* Not end of file */
"ExecIO 1 DiskW DDOut" /* Write a disk rec */
End
Else Do
"ExecIO 0 DiskR DDIn (Finis" /* Close the input file */
"ExecIO 0 DiskW DDOut (Finis" /* Close the output file */
Leave
End
End
"Free Fi(DDIn,DDOut)"
Do X=1 TO R1.0
R1.X = ''
P1.X = ''
End
End
End
End
call Rebuild_JCL
do j=1 to s
if j=1 then do
say '*-------------------------------------------------------------*'
say '*----------- The following overrides were given --------------*'
end
parse var ov.j part1 '.' part2 'DSN=' part3 '(' part4
if part1 \=stpart1 then
Do
say '*-------------------------------------------------------------*'
say part1
End
parse var part2 part5 '.' ddn 'DD' dsnl
if ddn = ' ' then
part=' DD DSN='³³pdsname³³'('³³part4
else
part=part2³³'DSN='³³pdsname³³'('³³part4
say " "part
stpart1=part1
if j=s then do
say '*-------------------------------------------------------------*'
end
End
do j=1 to s
parse var ov.j part1.j '.' part2 'DSN=' part3 '(' part4
parse var part2 part5 '.' ddn1 'DD' dsnl
if ddn1 = ' ' then
part.j='// DD DSN='³³pdsname³³'('³³part4
else
part.j='//'³³part2³³'DSN='³³pdsname³³'('³³part4
ADDRESS ISREDIT
"f all '//JSTEP'"
found='no'
do until found='yes'
"ISREDIT (presline) = LINE .ZCSR"
if substr(presline,3,8)=part1.j then
do
"f '//JSTEP'"
if rc=0 then
do
"ISREDIT (v) = LINENUM .ZCSR"
address "ISREDIT" "LINE_BEFORE "v"= " '"'part.j'"'
found='yes'
end
else
do
"ISREDIT (u) = LINENUM .ZLAST"
address "ISREDIT" "LINE_AFTER "u"= " '"'part.j'"'
found='yes'
end
"f prev '//JSTEP'"
End
else
do
"f next '//JSTEP'"
End
End
End
"f all '//'"
if s=0 then
do
address ispexec
ZEDLMSG = '*** No delete/define parms found!!! ***'
'SETMSG MSG(ISRZ001)';
end
else
do
address ispexec
ZEDLMSG = '*** Delete/define parms are overridden, Please check!!!***'
'SETMSG MSG(ISRZ001)';
end
Exit
/*------------*/
Rebuild_JCL:
/*------------*/
ADDRESS ISREDIT
"x all"
"del all x"
do x=1 to cnt
job.x=strip(y.x)
w=x-1
ln.x='"LINE_AFTER '³³w³³' ="'
address "ISREDIT" "LINE_AFTER "w"= " '"'job.x'"'
end
ADDRESS ISREDIT
"c all '›' '&'"
"res"
"f all '//' 1"
Return
/*----------------------*/
validate_parm2_member:
/*----------------------*/
parse var dataline bef 'DSN=' libr '(' mem1 ')'
subr1=substr(mem1,2,1)
if datatype(subr1,'N') then
do
if subr1\='0' then
mem2=substr(mem1,1,1)³³'0'³³substr(mem1,3,6)
else
mem2=mem1
end
else
mem2=mem1
/*if subr1\='0' then
mem2=substr(mem1,1,1)³³'0'³³substr(mem1,3,6)
else
mem2=mem1 */
mem2=strip(mem2)
valpds=libr³³'('³³mem2³³')'
X = OUTTRAP(N.)
RESULT = SYSDSN("'"valpds"'")
X = OUTTRAP(OFF)
IF RESULT = OK THEN
Do
ADDRESS TSO
X = OUTTRAP(N.)
"Alloc Fi(DDVL) da('"valpds"') SHR"
"EXECIO * DISKR DDVL (STEM V1. FINIS)"
"Free Fi(DDVL)"
X = OUTTRAP(OFF)
Do I=1 to V1.0
Rec1=V1.I
If index(Rec1,'DEFINE') = 0 then
Do
End
Else
Do
DlDf = 'Yes'
End
If index(Rec1,'DELETE') = 0 then
Do
End
Else
Do
DlDf = 'Yes'
End
End
End
Return
Exit
/* trace all */
/*
Purpose : To give proper override for del/def statements
How to use : After building/modifing the JCL (job), just go
inside the job and give 'JJ'. Later type
'md9999' to make them display, then type the
command 'deldef' in the command line.
*/
ADDRESS ISREDIT
s=0
DlDf = 'NO'
"MACRO"
/*---------------- below code is to capture JCL part ---------------*/
/*------------------ which will be re-written later ----------------*/
cnt=0
"ISREDIT (lastl) = LINENUM .ZLAST"
do curr=1 to lastl
"ISREDIT (datal) = LINE" Curr
if substr(datal,1,2) = "//" then
do
if substr(datal,1,25) = "// " then
do
end
else
do
cnt=cnt+1
if index(datal,"&") \= 0 then
do
datal= translate(datal,"›","&")
y.cnt=datal
end
y.cnt=datal
end
end
if substr(datal,1,2) = "/*" then
do
cnt=cnt+1
y.cnt=datal
end
end
/*--------------------- find job name ----------------------------*/
"f all '//' 1"
"ISREDIT (currline) = LINE .ZCSR"
parse var currline '//' jobname " " rest
/*--------------------- find job sub region ----------------------*/
"f all ' n='"
"ISREDIT (currlin1) = LINE .ZCSR"
parse var currlin1 some ' N=' subreg " " rest1
if subreg= '0' then
do
call Rebuild_JCL
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
if subreg = ' ' then
do
"f all ' db='"
"ISREDIT (currlin2) = LINE .ZCSR"
parse var currlin2 some ' DB=' subreg " " rest2
end
if subreg= '0' then
do
call Rebuild_JCL
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
/*--------------------- find job region ---------------------------*/
"f all ' HL1='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HL1=' reg " " rest2
if substr(reg,3,1) \= '2' then
"f next ' HL1='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HL1=' reg " " rest2
if reg= ' ' then
do
"f all ' HLX='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HLX=' reg " " rest2
if substr(reg,3,1) \= '2' then
"f next ' HLX='"
"ISREDIT (currlin3) = LINE .ZCSR"
parse var currlin3 some ' HLX=' reg " " rest2
end
if reg= 'XP2' then
do
"f all '//' 1"
address ispexec
ZEDLMSG = '*** All delete/define parms are proper!!! ***'
'SETMSG MSG(ISRZ001)';
exit
end
/*----- find all the Jobsteps, Procsteps and PR2s with del/def -----*/
"x all"
"f all '//jstep'"
"f all '//pstep'"
"f all '2.STD.PARMLIB2('"
"del all x"
"ISREDIT (lastline) = LINENUM .ZLAST"
If lastline \= 0 then
Do
Do Curr=1 TO lastline
"ISREDIT (dataline) = LINE" Curr
DlDf = 'No'
if index(dataline,'JSTEP') \= 0 then
do
parse var dataline '//'jstep' 'some0
end
if index(dataline,'PSTEP') \= 0 then
do
parse var dataline '//'pstep' 'some0
end
if index(dataline,'2.STD.PARMLIB2(') \= 0 then
do
parse var dataline '--'ddname' 'some 'DSN='mem","some2
parse var dataline '--'other','
call validate_parm2_member
end
if DlDf = 'Yes' then
do
override=jstep³³'.'³³pstep³³'.'³³other
s=s+1
ov.s=override
parse var override before 'DSN=' lib '(' memname ')'
subreg1=substr(memname,2,1)
if datatype(subr1,'N') then
do
if subr1\='0' then
memname1=substr(memname,1,1)³³'0'³³substr(memname,3,6)
else
memname1=memname
end
else
memname1=memname
/*if subreg1\='0' then
memname1=substr(memname,1,1)³³'0'³³substr(memname,3,6)
else
memname1=memname */
memname1=strip(memname1)
inpds=lib³³'('³³memname1³³')'
re=substr(reg,2,1)
outpds='XT2.SMS.'³³re³³'.PARMLIB2.R'³³subreg³³'('³³memname³³')'
finpds='XT2.SMS.'³³re³³subreg³³'.PARMLIB2('³³memname³³ ')'
parse var finpds pdsname '(' oth
ADDRESS TSO
"Alloc Fi(DDIn) da('"inpds"') shr"
"Alloc Fi(DDOut) da('"outpds"') shr"
Do Forever
"ExecIO 1 DiskR DDIn" /* Read a disk record*/
If RC = 0 then do /* Not end of file */
"ExecIO 1 DiskW DDOut" /* Write a disk rec */
End
Else Do
"ExecIO 0 DiskR DDIn (Finis" /* Close the input file */
"ExecIO 0 DiskW DDOut (Finis" /* Close the output file */
Leave
End
End
"Free Fi(DDIn,DDOut)"
srchstng=reg³³'.sms.'
ADDRESS TSO
"Alloc Fi(DDUp) da('"outpds"') OLD"
"EXECIO * DISKR DDUP (STEM P1. FINIS)"
Do I=1 to P1.0
Record=P1.I
if index(Record,'.SMS.') = 0 then
Do
R1.I=Record
End
Else
do
parse var Record brest '.SMS.' regchg '.' arest
regchg=substr(regchg,1,4)³³subreg
Record=brest³³'.SMS.'³³regchg³³'.'³³arest
R1.I=Record
End
End
R1.0=P1.0
"EXECIO * DISKW DDUp (STEM R1. FINIS)"
"FREE FI(DDup)"
ADDRESS TSO
"Alloc Fi(DDIn) da('"outpds"') shr"
"Alloc Fi(DDOut) da('"finpds"') shr"
Do Forever
"ExecIO 1 DiskR DDIn" /* Read a disk record*/
If RC = 0 then do /* Not end of file */
"ExecIO 1 DiskW DDOut" /* Write a disk rec */
End
Else Do
"ExecIO 0 DiskR DDIn (Finis" /* Close the input file */
"ExecIO 0 DiskW DDOut (Finis" /* Close the output file */
Leave
End
End
"Free Fi(DDIn,DDOut)"
Do X=1 TO R1.0
R1.X = ''
P1.X = ''
End
End
End
End
call Rebuild_JCL
do j=1 to s
if j=1 then do
say '*-------------------------------------------------------------*'
say '*----------- The following overrides were given --------------*'
end
parse var ov.j part1 '.' part2 'DSN=' part3 '(' part4
if part1 \=stpart1 then
Do
say '*-------------------------------------------------------------*'
say part1
End
parse var part2 part5 '.' ddn 'DD' dsnl
if ddn = ' ' then
part=' DD DSN='³³pdsname³³'('³³part4
else
part=part2³³'DSN='³³pdsname³³'('³³part4
say " "part
stpart1=part1
if j=s then do
say '*-------------------------------------------------------------*'
end
End
do j=1 to s
parse var ov.j part1.j '.' part2 'DSN=' part3 '(' part4
parse var part2 part5 '.' ddn1 'DD' dsnl
if ddn1 = ' ' then
part.j='// DD DSN='³³pdsname³³'('³³part4
else
part.j='//'³³part2³³'DSN='³³pdsname³³'('³³part4
ADDRESS ISREDIT
"f all '//JSTEP'"
found='no'
do until found='yes'
"ISREDIT (presline) = LINE .ZCSR"
if substr(presline,3,8)=part1.j then
do
"f '//JSTEP'"
if rc=0 then
do
"ISREDIT (v) = LINENUM .ZCSR"
address "ISREDIT" "LINE_BEFORE "v"= " '"'part.j'"'
found='yes'
end
else
do
"ISREDIT (u) = LINENUM .ZLAST"
address "ISREDIT" "LINE_AFTER "u"= " '"'part.j'"'
found='yes'
end
"f prev '//JSTEP'"
End
else
do
"f next '//JSTEP'"
End
End
End
"f all '//'"
if s=0 then
do
address ispexec
ZEDLMSG = '*** No delete/define parms found!!! ***'
'SETMSG MSG(ISRZ001)';
end
else
do
address ispexec
ZEDLMSG = '*** Delete/define parms are overridden, Please check!!!***'
'SETMSG MSG(ISRZ001)';
end
Exit
/*------------*/
Rebuild_JCL:
/*------------*/
ADDRESS ISREDIT
"x all"
"del all x"
do x=1 to cnt
job.x=strip(y.x)
w=x-1
ln.x='"LINE_AFTER '³³w³³' ="'
address "ISREDIT" "LINE_AFTER "w"= " '"'job.x'"'
end
ADDRESS ISREDIT
"c all '›' '&'"
"res"
"f all '//' 1"
Return
/*----------------------*/
validate_parm2_member:
/*----------------------*/
parse var dataline bef 'DSN=' libr '(' mem1 ')'
subr1=substr(mem1,2,1)
if datatype(subr1,'N') then
do
if subr1\='0' then
mem2=substr(mem1,1,1)³³'0'³³substr(mem1,3,6)
else
mem2=mem1
end
else
mem2=mem1
/*if subr1\='0' then
mem2=substr(mem1,1,1)³³'0'³³substr(mem1,3,6)
else
mem2=mem1 */
mem2=strip(mem2)
valpds=libr³³'('³³mem2³³')'
X = OUTTRAP(N.)
RESULT = SYSDSN("'"valpds"'")
X = OUTTRAP(OFF)
IF RESULT = OK THEN
Do
ADDRESS TSO
X = OUTTRAP(N.)
"Alloc Fi(DDVL) da('"valpds"') SHR"
"EXECIO * DISKR DDVL (STEM V1. FINIS)"
"Free Fi(DDVL)"
X = OUTTRAP(OFF)
Do I=1 to V1.0
Rec1=V1.I
If index(Rec1,'DEFINE') = 0 then
Do
End
Else
Do
DlDf = 'Yes'
End
If index(Rec1,'DELETE') = 0 then
Do
End
Else
Do
DlDf = 'Yes'
End
End
End
Return
Exit
Comments
Post a Comment