/* REXX */ 00010000
00020000
/* ----------------------------------------------------------------- */ 00030000
/* 00040000
Name : Y4PCDPA1 00050000
Autor : Heinz Bühler, 25.09.1998 00060000
Funktion : Package Cleanup Prozedur 00070000
00080000
Es wird die zum angegebenen Package gehörenden 00090000
SYSPACKage Information gelesen, und es werden 00100000
FREE PACKAGE Statements erstellt, so dass nur die 00110000
neuesten n Packages übrigbleiben. 00120000
00130000
Der generierte FREE Command wird angezeigt, und 00140000
ein entsprechender JOB wird abgelegt. 00150000
00160000
Aufruf : TSO Y4PCDPA1 00170000
Components Panel Y4PCDPA1 00180000
Panel Y4PCDPAH 00190000
Prog DSNREXX 00200000
00210000
Change Activity : 00220000
V1R0 : 18.05.2000/HBD 00230000
- Ursprungs-Version 00240000
V1R1 : 19.04.2001/HBD 00250000
- more SQL predicates eingefügt 00260000
- 3 Versuche bei fehlenden Selektionsangaben 00270000
V1R2 : 02.05.2001/HBD 00280000
- umgestellt auf DSNREXX 00290000
V1R3 : 23.12.2002/HBD 00300000
- BIND COPY JCL Gen eingebaut 00310000
V1R4 : 07.01.2003/HBD 00320000
- Such-Query für ältesten Modul eingebaut 00330000
(ausgewählt wenn 999 Versionen eingegeben wird) 00340000
V1R5 : 13.02.2004/HBD 00350000
- Such-Query für Minimum Alter geändert y4dsmona 00360000
V1R6 : 10.05.2004/HBD 00370000
- Remote Connection entfernt 00380000
V2R7 : 05.04.2006/HBD 00390000
- Support für Reconnect bei SSID Wechsel 00400000
- MAIN CLASS Karte aus JobKarte 00410000
*/ 00420000
/* ----------------------------------------------------------------- */ 00430000
00440000
address tso; 00450000
/* EXECUTIL TS ; */ 00460000
00470000
pgmvers='V2R7' 00480000
debug=0; 00490000
00500000
rc=0; 00510000
call setvars; 00520000
call create_messg; 00530000
call init_dsnrexx; 00540000
00550000
00560000
rc=0; /* init return code variable */ 00570000
zcmd=''; /* init zcmd variable */ 00580000
00590000
/* ----------------------------------------------------------------- */ 00600000
/* Loop : Panel Y4PCPLAN ausgeben, bis PF3 gedrückt wird */ 00610000
/* ----------------------------------------------------------------- */ 00620000
sa='' 00630000
return_fl = 'N' 00640000
vv_scnt=3 00650000
do while(rc=0 & strip(zcmd)=''); 00660000
address ispexec; 00670000
'addpop'; /* display panel as popup */ 00680000
x = 'DB2 PACKAGE CLEANUP - JCL-Generator' 00690000
zwinttl = x || ' --- 'rzid'/'mvsid' --- 'pgmvers 00700000
address ispexec; 00710000
'display panel(Y4PCDPA1) cursor(y4dsssid)'; 00720000
00730000
if rc>0 | strip(zcmd)<>'' /* exit when PF3 or Command */ 00740000
then iterate; 00750000
00760000
call plaus_input ; 00770000
if pl_rc>0 then do /* exit when plaus rc=8 */ 00780000
address ispexec; 00790000
'rempop'; 00800000
address tso ; 00810000
iterate; 00820000
end 00830000
00840000
call alloccmd; /* alloc JCL File */ 00850000
if batchmode then do 00860000
call process_batch 00870000
if return_fl = 'Y' then do 00880000
address ispexec; 00890000
'rempop'; 00900000
address tso ; 00910000
iterate 00920000
end 00930000
end 00940000
else do 00950000
call process_dialog 00960000
if Pkg_Found = 'NO' then do 00970000
sa=ispfmsg('No Package 'y4dspkg' found ...'); 00980000
address ispexec; 00990000
'rempop'; 01000000
address tso ; 01010000
iterate 01020000
end 01030000
if return_flag='RETURN' then do 01040000
address ispexec; 01050000
'rempop'; 01060000
address tso ; 01070000
iterate 01080000
end 01090000
end 01100000
01110000
01120000
address ispexec 'rempop'; /* remove popup window */ 01130000
/* aufrufen des ISPF EDIT Service, falls was gefunden wurde */ 01140000
if Pkg_Found = "YES" then do 01150000
address ISPEXEC ; 01160000
"EDIT DATASET('"CMDDS"')" ; 01170000
address tso; 01180000
msg_status = MSG(ON) 01190000
"FREE DATASET('"CMDDS"')" ; 01200000
msg_status = MSG(OFF) 01210000
end ; 01220000
01230000
call create_messg; 01240000
01250000
rc=0 ; /* reset rc to 0 to force iteration */ 01260000
end; /* end-do-while */ 01270000
01280000
01290000
call db2_commit; 01300000
call caf_disconnect; 01310000
call exit_dsnrexx; 01320000
exit ; 01330000
01340000
01350000
01360000
01370000
/* ----------------------------------------------------------------- */ 01380000
/* Processing bei Dialogbetrieb */ 01390000
/* ----------------------------------------------------------------- */ 01400000
01410000
process_dialog: 01420000
if debug then say 'PROC: process_dialog' 01430000
call read_pkg; 01440000
if Pkg_Found = 'NO' then return 01450000
if return_flag='RETURN' then return 01460000
01470000
/* Jobheader JCL generieren */ 01480000
if y4sgcmd = 'FREE' then do 01490000
call genjob00_free ; 01500000
end 01510000
else do 01520000
call genjob00_bind ; 01530000
end 01540000
01550000
/* Commands auf file schreiben */ 01560000
address tso; 01570000
'EXECIO * DISKW CMDDNDPA (STEM CMD. FINIS' 01580000
return; 01590000
01600000
01610000
/* ----------------------------------------------------------------- */ 01620000
/* Processing bei Batchbetrieb */ 01630000
/* ----------------------------------------------------------------- */ 01640000
01650000
process_batch: 01660000
if debug then say 'PROC: process_batch' 01670000
01680000
/* Read input Member, return if not found */ 01690000
call read_input 01700000
if return_fl = 'Y' then return 01710000
01720000
call report_connection 01730000
01740000
/* ------------------------------------------------ */ 01750000
/* FREE Statements generieren, in stem CMD. ablegen */ 01760000
/* ------------------------------------------------ */ 01770000
01780000
cmdt. = '' /* Stem fuer alle statements, ohne JCL */ 01790000
ti = 1 01800000
/* Input stem inp. lesen, Namen extrahieren */ 01810000
do pbmi = 1 to inp.0 01820000
if debug then say 'PROC: process_batch, Main Loop' 01830000
xxpkg = '' 01840000
xxcoll = '' 01850000
xxnum = '' 01860000
01870000
inp_line = substr(inp.pbmi,1,50) 01880000
if debug then say 'inp_line: 'inp_line 01890000
xx = substr(inp_line,1,2) 01900000
01910000
/* Kommentarzeilen ueberlesen */ 01920000
if (xx='* ' | xx='**' | xx='--' | xx='/*' | xx = ' ') then do 01930000
if debug then say 'I'pbmi': 'xx' wird ueberlesen' 01940000
iterate 01950000
end 01960000
01970000
xx = inp_line 01980000
parse var xx xxpkg xxcoll xxnum '.' 01990000
02000000
/* Package Name, exakt, kein % anfuegen */ 02010000
x4dspkg = strip(xxpkg) 02020000
02030000
/* Collection Name, optional */ 02040000
if xxcoll <> '' then x4dscoll = xxcoll 02050000
else x4dscoll = '%' 02060000
x4dscoll = xprocpos(x4dscoll) 02070000
02080000
/* Anzahl uebrigzulassender Packages, optional */ 02090000
if xxnum <> '' then x4dsnum2 = xxnum 02100000
else x4dsnum2 = y4dsnum2 02110000
02120000
if debug then say 'Reading Information for 'x4dspkg 02130000
if debug then say '.. COLLID='x4dscoll' Num='x4dsnum2 02140000
call read_pkg; 02150000
02160000
/* resultierende Statements aus cmd. in cmdt. anfuegen */ 02170000
i=1 02180000
do until i > cmd.0 02190000
cmdt.ti = cmd.i 02200000
i = i + 1 02210000
ti= ti+ 1 02220000
end 02230000
ti= ti- 1 02240000
if debug then say '.. found 'cmd.0' packages for 'x4dspkg 02250000
if debug then say '.. total 'ti' packages' 02260000
02270000
end 02280000
cmdt.0 = ti - 1 02290000
if debug then say 'PROC: process_batch, Main Loop End ' 02300000
if debug then say '.. total 'ti' packages stacked' 02310000
if cmdt.0 > 0 then Pkg_Found = "YES"; 02320000
02330000
/* ------------------------------------------------ */ 02340000
/* JCL generieren (JOB Header) */ 02350000
/* ------------------------------------------------ */ 02360000
address tso ; 02370000
"newstack"; 02380000
call genjob00_free ; 02390000
i=1 02400000
anzstmt=0 02410000
do until i > cmdt.0 02420000
if debug then say 'cmd:'cmdt.i 02430000
queue cmdt.i 02440000
i = i + 1 02450000
if y4donbr2 <> '' then do 02460000
anzstmt = anzstmt + 1 02470000
if (anzstmt > y4donbr2 - 1) then do 02480000
call genjob00_free 02490000
anzstmt=0 02500000
end 02510000
end 02520000
end 02530000
02540000
address tso; 02550000
'EXECIO 'queued()' DISKW CMDDNDPA (FINIS ' 02560000
address tso ; 02570000
"delstack"; 02580000
return; 02590000
02600000
/* ----------------------------------------------------------------- */ 02610000
/* Anzeige der Connection zum DB2 */ 02620000
/* ----------------------------------------------------------------- */ 02630000
02640000
report_connection: 02650000
if debug then say 'PROC: report_connection' 02660000
address tso; 02670000
/* Connection zu DB2 */ 02680000
MESSG = "Connect to DB2 Subsystem "connssid" ..." 02690000
MESSG = time() || " " || MESSG 02700000
call Send_messg; 02710000
02720000
MESSG = 'Reading from DB2 Subsystem 'trg_ssid' ...' 02730000
MESSG = time() || " " || MESSG 02740000
call Send_messg 02750000
return; 02760000
02770000
02780000
/* ----------------------------------------------------------------- */ 02790000
/* Query gegen SYSPACKAGE */ 02800000
/* ----------------------------------------------------------------- */ 02810000
02820000
read_pkg: 02830000
if debug then say 'PROC: read_pkg' 02840000
02850000
/* create ISPF Table */ 02860000
address ispexec; 02870000
"TBCREATE INTTBL NAMES( XCOLLID,XNAME,XVERSION,XPCTS,XTS,XQUAL)", 02880000
" NOWRITE REPLACE" 02890000
if rc > 4 then say "TBCREATE INTTBL, RC="rc 02900000
02910000
address tso; 02920000
02930000
if y4dsnum2 = 999 then call build_sql_for_oldest_mod 02940000
else call build_sql_for_leave_newest 02950000
numpkgs = 0 02960000
02970000
MESSG = 'Reading SYSPACKAGE Information for 'x4dspkg' ...' 02980000
MESSG = time() || " " || MESSG 02990000
call Send_messg 03000000
03010000
/* declare a cursor for a prepared SQL Statement */ 03020000
/* Cursor Names must be : */ 03030000
/* - 'C1' thru 'C50' for cursors without the WITH HOLD option */ 03040000
/* - 'C51' thru 'C100' for cursors with the WITH HOLD option */ 03050000
/* - 'C101' thru 'C200' for cursors that retrieve Result Sets in */ 03060000
/* Programs that call a Stored Procedure */ 03070000
/* Prepared Statement Names must be: */ 03080000
/* - 'S1' thru 'S100' for DECLARE STATEMENT, PREPARE, DESCRIBE */ 03090000
/* and EXECUTE Statements */ 03100000
ADDRESS DSNREXX 03110000
'EXECSQL DECLARE C1 CURSOR FOR S1' 03120000
if sqlcode <> 0 then call rep_sqlca "DECLARE C1" 03130000
03140000
/* Prepare the SQL Statement, assign a Statement Name */ 03150000
ADDRESS DSNREXX 03160000
'EXECSQL PREPARE S1 INTO :OUTSQLDA FROM :SQL' 03170000
if sqlcode <> 0 then do 03180000
say 'SQL Statement in error:' 03190000
say '----------------------' 03200000
say ' ' 03210000
say sql 03220000
call rep_sqlca "PREPARE S1" 03230000
return_flag = "RETURN" 03240000
return 03250000
end 03260000
03270000
/* Open Cursor C1 */ 03280000
ADDRESS DSNREXX 'EXECSQL OPEN C1' 03290000
if sqlcode <> 0 then call rep_sqlca "OPEN C1" 03300000
03310000
/* FETCH from Cursor C1, using Host Varables */ 03320000
/* to retrieve the data */ 03330000
Do Until(SQLCODE ^= 0) 03340000
ADDRESS DSNREXX 03350000
'EXECSQL FETCH C1 INTO :COLLID,:NAME,:VERSION,:QUALIFIER,', 03360000
':PCTS,:TS' 03370000
if (sqlcode <> 0 & sqlcode <> 100) then , 03380000
call rep_sqlca "FETCH C1" 03390000
If SQLCODE = 0 Then Do 03400000
numpkgs = numpkgs + 1 03410000
xcollid = collid 03420000
XNAME = name 03430000
XVERSION= version 03440000
XPCTS = pcts 03450000
XTS = ts 03460000
XQUAL = qualifier 03470000
address ispexec "tbadd inttbl" 03480000
If rc<>0 then say "tbadd inttbl, rc="rc 03490000
End 03500000
End 03510000
03520000
/* Close Cursor C1 */ 03530000
ADDRESS DSNREXX 'EXECSQL CLOSE C1' 03540000
if sqlcode <> 0 then call rep_sqlca "CLOSE C1" 03550000
03560000
/* COMMIT the work */ 03570000
ADDRESS DSNREXX "EXECSQL COMMIT" 03580000
if sqlcode <> 0 then call rep_sqlca "COMMIT" 03590000
03600000
03610000
/* ISPF Table sortieren */ 03620000
address ispexec; 03630000
"tbsort inttbl fields(xcollid,c,a, xname,c,a, xversion,c,a)" 03640000
If rc<>0 then say "tbsort inttbl, rc="rc 03650000
03660000
cmd. = '' 03670000
cmd.0= 0 03680000
Pkg_Found = "NO"; 03690000
At_Least_1_Row = "NO" ; 03700000
j=1; 03710000
cmd. = '' 03720000
address ispexec; 03730000
"tbtop inttbl"; 03740000
03750000
/* -------------------- fetch loop */ 03760000
Do Forever ; 03770000
03780000
address ispexec; 03790000
"tbskip inttbl"; 03800000
03810000
If ( rc<>0 & rc<>8 ) then say "tbskip, rc="rc 03820000
if rc<>0 Then Leave ; 03830000
At_Least_1_Row = "YES" ; 03840000
03850000
Pkg_Found = "YES"; 03860000
03870000
RXName = strip(xNAME) ; 03880000
RXCollid = strip(xCOLLID) ; 03890000
RXVersion = strip(xVERSION) ; 03900000
RXQual = strip(xQual) ; 03910000
RXPCTS = strip(xPCTS) ; 03920000
RXTS = strip(xTS) ; 03930000
03940000
if y4dsgcmd = 'FREE' then do 03950000
/* FREE PACKAGE Statement generieren */ 03960000
cmd.j = 'FREE PACKAGE ('RXCollid'.'RXName'.('RXVersion'))' 03970000
j=j+1; 03980000
end 03990000
else do 04000000
/* BIND COPY Statement generieren */ 04010000
cmd.j = 'BIND PACKAGE ('y4dstcol') - ' 04020000
j=j+1; 04030000
04040000
cmd.j = ' COPY ('RXCollid'.'RXName') -' 04050000
j=j+1; 04060000
04070000
if RXVersion <> '' then do 04080000
cmd.j = ' COPYVER ('RXVersion') -' 04090000
j=j+1; 04100000
end 04110000
04120000
cmd.j = ' QUALIFIER('RXQual') -' 04130000
j=j+1; 04140000
04150000
if y4dsownr <> '' then do 04160000
cmd.j = ' OWNER('y4dsownr') - ' 04170000
j=j+1; 04180000
end 04190000
04200000
if y4dsdefr = 'YES' then do 04210000
cmd.j = ' DEFER(PREPARE) -' 04220000
j=j+1; 04230000
end 04240000
cmd.j = ' ACTION(REPLACE)' 04250000
j=j+1; 04260000
04270000
end 04280000
04290000
end /* do forever */ 04300000
04310000
if At_Least_1_Row = "NO" then do 04320000
Pkg_Found = "NO"; 04330000
if debug then say "no Package found ..."; 04340000
xx=ispfmsg('No PACKAGE 'y4dipkg' found ...'); 04350000
end ; 04360000
04370000
Address TSO ; 04380000
cmd.0 = j-1; 04390000
04400000
return ; 04410000
04420000
04430000
/*---------------------------------------------------*/ 04440000
/* SQL zum übriglassen der neuesten n packages */ 04450000
/*---------------------------------------------------*/ 04460000
build_sql_for_leave_newest: 04470000
if debug then say 'PROC: build_sql_for_leave_newest' 04480000
04490000
address tso; 04500000
/* assign SQL text to a variable */ 04510000
SQL = 'SELECT COLLID,NAME,VERSION,QUALIFIER,', 04520000
'PCTIMESTAMP AS PCTS,', 04530000
'TIMESTAMP AS TS ', 04540000
" FROM "tlocation"SYSIBM.SYSPACKAGE A", 04550000
" WHERE "x4dsnum2" < (SELECT COUNT(*)", 04560000
" FROM "tlocation"SYSIBM.SYSPACKAGE B", 04570000
" WHERE A.PCTIMESTAMP < B.PCTIMESTAMP", 04580000
" AND A.LOCATION = B.LOCATION", 04590000
" AND A.COLLID = B.COLLID", 04600000
" AND A.NAME = B.NAME)" 04610000
if strip(y4dstcol) = 'INC_BACKUP' then do 04620000
sql = sql || " AND A.COLLID <> 'INC_BACKUP'" 04630000
end 04640000
04650000
if pos('%',x4dspkg) > 0 then , 04660000
sql = sql || " AND NAME LIKE '"x4dspkg"'" 04670000
else 04680000
sql = sql || " AND NAME = '"x4dspkg"'" 04690000
04700000
sql = sql || " AND COLLID LIKE '"x4dscoll"'", 04710000
" AND A.PCTIMESTAMP < CURRENT TIMESTAMP - "y4dsmona "MONTHS " 04720000
04730000
if y4dspre1<>'' then sql=sql || y4dspre1 04740000
if y4dspre2<>'' then sql=sql || y4dspre2 04750000
04760000
sql = sql || " ORDER BY 1,2,3" 04770000
if debug then say sql; 04780000
return; 04790000
04800000
04810000
04820000
/* SQL zum löschen des jeweils aeltesten packages */ 04830000
/* dieses SQL wird gegen Module eingesetzt */ 04840000
build_sql_for_oldest_mod: 04850000
if debug then say 'PROC: build_sql_for_oldest_mod' 04860000
04870000
address tso; 04880000
/* SELECT jeweils den ältesten Package */ 04890000
/* pro dbrm und Collection ID */ 04900000
/* wenn mindestens 10 Versionen vorhanden sind */ 04910000
/* und der älteste nicht jünger als 12 Monate */ 04920000
SQL='SELECT A.COLLID,A.NAME,A.VERSION,A.QUALIFIER,', 04930000
'A.PCTIMESTAMP AS PCTS,A.TIMESTAMP AS TS ', 04940000
'FROM 'tlocation'SYSIBM.SYSPACKAGE A ', 04950000
' INNER JOIN ( ', 04960000
' SELECT B.COLLID,B.NAME,COUNT(*) ', 04970000
' FROM 'tlocation'SYSIBM.SYSPACKAGE B ' 04980000
04990000
if xd4scoll <> '%' then do 05000000
sql = sql || " WHERE B.COLLID LIKE '"x4dscoll"' " 05010000
sql = sql || " AND B.NAME <> 'Y4PBALTR' " 05020000
end 05030000
05040000
sql=sql || 'GROUP BY B.COLLID,B.NAME ', 05050000
' HAVING COUNT(*) > 07 ) AS N1 ', 05060000
' ON N1.COLLID = A.COLLID ', 05070000
' AND N1.NAME = A.NAME ', 05080000
' INNER JOIN ( ', 05090000
' SELECT COLLID,NAME,MIN(PCTIMESTAMP) AS PCT ', 05100000
' FROM 'tlocation'SYSIBM.SYSPACKAGE ', 05110000
05120000
if xd4scoll <> '%' then do 05130000
sql = sql || " WHERE COLLID LIKE '"x4dscoll"' " 05140000
end 05150000
05160000
sql=sql || 'GROUP BY COLLID,NAME ) AS N2 ', 05170000
' ON N2.COLLID = A.COLLID ', 05180000
' AND N2.NAME = A.NAME', 05190000
' AND N2.PCT = A.PCTIMESTAMP', 05200000
" WHERE A.COLLID <> 'INC_BACKUP'", 05210000
' AND A.PCTIMESTAMP < CURRENT TIMESTAMP - 12 MONTHS' 05220000
05230000
if xd4scoll <> '%' then do 05240000
sql = sql || " AND A.COLLID LIKE '"x4dscoll"' " 05250000
end 05260000
sql=sql || 'ORDER BY 1,2 ' 05270000
; 05280000
if debug then say sql; 05290000
return; 05300000
05310000
05320000
05330000
05340000
/* ----------------------------------------------------------- */ 05350000
/* Input Plausibilisierung */ 05360000
/* ----------------------------------------------------------- */ 05370000
plaus_input: 05380000
if debug then say 'PROC: plaus_input' 05390000
address tso; 05400000
/* executil ts */ 05410000
05420000
pl_rc=0 05430000
Pkg_Found = 'NO' 05440000
05450000
/* Location Qualifier des Target Systems bestimmen */ 05460000
trg_ssid = y4dsssid 05470000
connssid = trg_ssid 05480000
tlocation = '' 05490000
if debug then say "Connect SSID = "connssid 05500000
if debug then say "Target SSID = "trg_ssid 05510000
05520000
call caf_disconnect 05530000
call caf_connect 05540000
05550000
05560000
/* Betriebsart (ein Package, oder eine Liste) */ 05570000
if y4dimod2 = 'PANEL' then do /* nur den eingegebenen */ 05580000
dialogmode = 1 /* Plan verarbeiten */ 05590000
batchmode = 0 05600000
end 05610000
else do /* Liste laut File verarbeiten */ 05620000
batchmode = 1 ; 05630000
dialogmode = 0 05640000
end 05650000
05660000
/* Names of Source Objects V1R2 */ 05670000
05680000
/* Package Name */ 05690000
/* V1R2: x4dspkg = xprocpos(y4dspkg) */ 05700000
/* -> bleiben so wie eingegeben */ 05710000
/* fehlendes '%' wird nicht angefügt) */ 05720000
x4dspkg = y4dspkg 05730000
05740000
/* Collection ID */ 05750000
/* fehlendes '%' wird angefügt */ 05760000
x4dscoll = xprocpos(y4dscoll) 05770000
05780000
/* Anzahl Generationen (min 3) */ 05790000
if y4dsnum2 < 3 & override=0 05800000
then do 05810000
if debug then say "leave at least 3 generations ..." 05820000
xx=ispfmsg('Please keep at least 3 generations ...'); 05830000
pl_rc = 8 05840000
override=1 05850000
return 05860000
end 05870000
x4dsnum2 = y4dsnum2 - 1 05880000
05890000
/* Return, if nothing selected */ 05900000
if ( x4dspkg='%' & x4dscoll='%') & dialogmode = 1 then do 05910000
if vv_scnt>0 then do 05920000
if debug then say "nothing selected, we return ..." 05930000
xx=ispfmsg('Please make some selection ...('vv_scnt')'); 05940000
pl_rc = 8 05950000
vv_scnt=vv_scnt-1 05960000
return 05970000
end 05980000
else do 05990000
vv_scnt = 3 06000000
end 06010000
end 06020000
06030000
/* Input Dataset und Member Name (bei Batch-Betrieb) */ 06040000
INPDS = y4didsn2; 06050000
imember = y4dimem2; 06060000
06070000
/* Output Dataset Name für JCL */ 06080000
address ispexec; 06090000
CMDDS = y4dodsn2 06100000
06110000
return; 06120000
06130000
06140000
/* ----------------------------------------------------------- */ 06150000
/* Initialize Variables (einmal, am Anfang des Programms) */ 06160000
/* ----------------------------------------------------------- */ 06170000
setvars: 06180000
if debug then say 'PROC: setvars' 06190000
msg_status = MSG(OFF) /* turn off msg prompt **/ 06200000
mvsid = mvsvar(sysname) 06210000
rzid = sysvar(sysnode) 06220000
pid = sysvar(sysuid) 06230000
06240000
override=0 06250000
06260000
/*----------------------------------------------------*/ 06270000
/* Environment Names definieren (pro RZ) */ 06280000
/*----------------------------------------------------*/ 06290000
/* DB2 Version und Loadlib bestimmen */ 06300000
/* Connection DB2 Subsystem bestimmen */ 06310000
/* SQLISPF Library bestimmen (LIBDEF) */ 06320000
/* Cartridge Unit Names (Esoterics) bestimmen */ 06330000
call "y4p@edef" 06340000
address ispexec 06350000
"vget (cartloc, cartrem ) shared" 06360000
"vget (connssid, netid ) shared" 06370000
"vget (db2vers, vdsnload) shared" 06380000
if debug then say " .. Local CART: "cartloc 06390000
if debug then say " .. Remote CART: "cartrem 06400000
if debug then say " .. Connect SSID: "connssid 06410000
if debug then say " .. DB2 Version, Loadlib: "db2vers vdsnload 06420000
if debug then say " .. NetID: "netid 06430000
06440000
ssid = connssid 06450000
ADDRESS ISPEXEC "VPUT (SSID) SHARED" 06460000
if debug then say "Connect SSID = "connssid 06470000
/*----------------------------------------------------*/ 06480000
06490000
return; 06500000
06510000
06520000
/** **/ 06530000
/** Check that TEMP Dataset exists **/ 06540000
/** **/ 06550000
alloccmd: 06560000
if debug then say 'PROC: alloccmd' 06570000
address tso; 06580000
dsn = CMDDS; 06590000
check_dsn = Sysdsn(''''dsn'''') 06600000
If check_dsn ^= 'OK' Then do 06610000
MESSG = CHECK_DSN" ( SYSDSN() )" 06620000
MESSG = time() || " " || MESSG 06630000
call Send_messg 06640000
/** allocate TEMP dataset **/ 06650000
if debug then say 'allocating a new 'dsn' ...'; 06660000
x = OutTrap(OFF) 06670000
/* 06680000
x = OutTrap(hide.) 06690000
*/ 06700000
"ALLOCATE FILE(CMDDNDPA) DATASET('"dsn"') NEW CATALOG ", 06710000
"SPACE(1,5) CYLINDERS", 06720000
"MGMTCLAS(COM#E035) STORCLAS(ALL$N) DATACLAS(FB0080S0)" 06730000
If RC ^= 0 Then do 06740000
MESSG = 'Allocation of new DATASET failed, RC='RC 06750000
MESSG = time() || " " || MESSG 06760000
call Send_messg 06770000
pull xx ; 06780000
exit 16; 06790000
end; 06800000
end 06810000
else do 06820000
if debug then say 'allocating existing 'dsn' ...'; 06830000
x = OutTrap(OFF) 06840000
"ALLOC F(CMDDNDPA) DA('"dsn"') SHR " 06850000
If RC ^= 0 Then do 06860000
MESSG = 'Allocation of existing DATASET failed, RC='RC 06870000
MESSG = time() || " " || MESSG 06880000
call Send_messg 06890000
pull xx ; 06900000
MESSG = "Name : "dsn 06910000
MESSG = time() || " " || MESSG 06920000
call Send_messg 06930000
exit 16; 06940000
end; 06950000
end 06960000
return; 06970000
06980000
06990000
/* ----------------------------------------------------------- */ 07000000
/* Read Input Member in Batch Mode */ 07010000
/* ----------------------------------------------------------- */ 07020000
read_input: 07030000
if debug then say 'PROC: alloccmd' 07040000
address tso; 07050000
dsn = INPDS; 07060000
if debug then say INPDS; 07070000
/* check if file exists, return if not */ 07080000
check_dsn = Sysdsn(''''dsn'''') 07090000
If check_dsn ^= 'OK' Then do 07100000
if debug then say dsn 'Input File 'dsn' missing in ' || rzid || '.' 07110000
address ispexec; 07120000
sa=ispfmsg('Input File 'INPDS' missing ...'); 07130000
return_fl = 'Y' 07140000
return 07150000
end 07160000
/* check if member exists, return if not */ 07170000
check_dsn = Sysdsn(''''dsn"("imember")"'''') 07180000
If check_dsn ^= 'OK' Then do 07190000
if debug then say 'Member 'imember' missing in 'dsn'.' 07200000
address ispexec; 07210000
sa=ispfmsg('Member 'imember' missing in 'dsn'.') 07220000
return_fl = 'Y' 07230000
return 07240000
end 07250000
07260000
if debug then do 07270000
say 'allocating Input File ...' ; 07280000
say "reading "dsn"("imember")'" 07290000
end 07300000
"ALLOC F(INPDN) DA('"dsn"("imember")') SHR " 07310000
'EXECIO * DISKR INPDN (STEM INP. FINIS' 07320000
"FREE DATASET('"INPDS"')" ; 07330000
return; 07340000
07350000
07360000
/***************************************************************/ 07370000
/** Generate JOB JCL **/ 07380000
/***************************************************************/ 07390000
genjob00_bind: 07400000
if debug then say 'PROC: genjob00_bind' 07410000
queue y4djob12 07420000
queue y4djob22 07430000
queue y4djob32 07440000
queue "//* " 07450000
queue "//* DB2 CATALOG CLEANUP (BACKUP BIND COPY)" 07460000
queue "//* ("numpkgs" PACKAGES)" 07470000
queue "//* " 07480000
queue "//STEP01 EXEC PGM=IKJEFT01,DYNAMNBR=20" 07490000
queue "//SYSTSPRT DD SYSOUT=* " 07500000
queue "//SYSPRINT DD SYSOUT=* " 07510000
queue "//SYSTSIN DD * " 07520000
queue " DSN SYSTEM("trg_ssid")" 07530000
07540000
address tso ; 07550000
'EXECIO 'queued()' DISKW CMDDNDPA ' 07560000
return; 07570000
07580000
07590000
/***************************************************************/ 07600000
/** Generate JOB JCL **/ 07610000
/***************************************************************/ 07620000
genjob00_free: 07630000
if debug then say 'PROC: genjob00_free' 07640000
queue y4djob12 07650000
queue y4djob22 07660000
queue y4djob32 07670000
queue "//* " 07680000
queue "//* DB2 CATALOG CLEANUP (FREE PACKAGES) " 07690000
queue "//* ("numpkgs" PACKAGES)" 07700000
queue "//* " 07710000
queue "//STEP01 EXEC PGM=IKJEFT01,DYNAMNBR=20" 07720000
queue "//SYSTSPRT DD SYSOUT=* " 07730000
queue "//SYSPRINT DD SYSOUT=* " 07740000
queue "//SYSTSIN DD * " 07750000
queue " DSN SYSTEM("trg_ssid")" 07760000
07770000
address tso ; 07780000
'EXECIO 'queued()' DISKW CMDDNDPA ' 07790000
return; 07800000
07810000
07820000
07830000
/*-------------------------------------------------------------------*/ 07840000
/* ISPF Message anzeigen */ 07850000
/*-------------------------------------------------------------------*/ 07860000
/* -PROC- */ 07870000
ispfmsg: 07880000
address ispexec; 07890000
parse arg lmsg 07900000
ZEDLMSG = lmsg 07910000
address ispexec "setmsg msg(isrz000)" ; 07920000
return 0; 07930000
07940000
07950000
07960000
07970000
/* ----------------------------------------------------------------- */ 07980000
/* Create a MSG Table per User, delete old content, write to DASD */ 07990000
/* ----------------------------------------------------------------- */ 08000000
Create_messg: 08010000
MESSG = "S" || pid 08020000
ADDRESS ISPEXEC "TBCREATE Y4PMSGTB NAMES(MESSG) NOWRITE REPLACE" 08030000
if rc > 4 then say "TBCREATE RC="rc 08040000
Return; 08050000
08060000
08070000
08080000
/* ----------------------------------------------------------------- */ 08090000
/* display the Message Table */ 08100000
/* ----------------------------------------------------------------- */ 08110000
Send_messg: 08120000
zwinttl = 'DB2 PACKAGE Cleanup'; 08130000
ADDRESS ISPEXEC "TBADD Y4PMSGTB" 08140000
ADDRess ISPEXEC "CONTROL DISPLAY LOCK " 08150000
ADDRESS ISPEXEC "ADDPOP ROW(5) COLUMN(4)" 08160000
ADDRESS ISPEXEC "TBDISPL Y4PMSGTB PANEL(Y4PMSG01)" 08170000
ADDRESS ISPEXEC REMPOP 08180000
Return; 08190000
08200000
08210000
08220000
/* pad with spaces (left Side of xstring) */ 08230000
npad: 08240000
arg xstring, xlen 08250000
if length(xstring) > xlen then do 08260000
xstring = right(xstring,xlen) 08270000
end 08280000
if length(xstring) < xlen then do 08290000
xstring = copies(' ',(xlen-length(xstring))) || xstring 08300000
end 08310000
return xstring; 08320000
08330000
/* pad with spaces (right Side of xstring) */ 08340000
xpad: 08350000
arg xstring, xlen 08360000
if length(xstring) > xlen then do 08370000
xstring = left(xstring,xlen) 08380000
end 08390000
if length(xstring) < xlen then do 08400000
xstring = xstring || copies(' ',(xlen-length(xstring))) 08410000
end 08420000
return xstring; 08430000
08440000
08450000
/* Wert aufbereiten für SQL LIKE ..*/ 08460000
/* ('*' wir durch '%' ersetzt, */ 08470000
/* fehlendes '%' wird angefügt) */ 08480000
xprocpos: 08490000
arg xstring 08500000
xstring=strip(xstring) 08510000
STERNPOS = pos('*',xstring) 08520000
if STERNPOS > 0 then do 08530000
xstring = overlay('%',xstring,STERNPOS) 08540000
end 08550000
procpos = pos('%',xstring) 08560000
if procpos = 0 then xstring = xstring || '%' 08570000
return xstring; 08580000
08590000
08600000
08610000
08620000
/*-------------------------------------------------------------------*/ 08630000
/* DB2 COMMIT */ 08640000
/*-------------------------------------------------------------------*/ 08650000
db2_commit: 08660000
if debug then say 'proc: db2_commit' 08670000
ADDRESS DSNREXX "EXECSQL COMMIT" 08680000
if sqlcode <> 0 then call rep_sqlca "COMMIT" 08690000
return; 08700000
08710000
08720000
08730000
/*-------------------------------------------------------------------*/ 08740000
/* CAF CONNECT zu DB2 */ 08750000
/*-------------------------------------------------------------------*/ 08760000
caf_connect: 08770000
if debug then say 'proc: caf_connect' 08780000
08790000
if debug then say ' CONNSSID: 'connssid 08800000
/* SQL Connect to the desired DB2 Subsystem or Sharing Group */ 08810000
ADDRESS DSNREXX "CONNECT "connssid 08820000
if sqlcode <> 0 then call rep_sqlca "CONNECT" 08830000
08840000
/* select the ISOLATION Level, in this example Cursor Stability */ 08850000
ADDRESS DSNREXX "EXECSQL SET CURRENT PACKAGESET='DSNREXCS'" 08860000
if sqlcode <> 0 then, 08870000
call rep_sqlca "SET CURRENT PACKAGESET='DSNREXCS'" 08880000
return; 08890000
08900000
08910000
/* ----------------------------------------------------------------- */ 08920000
/* Disconnect from DB2 */ 08930000
/* ----------------------------------------------------------------- */ 08940000
caf_disconnect: 08950000
if debug then say 'proc: caf_disconnect' 08960000
/* SQL DISCONNECT */ 08970000
ADDRESS DSNREXX "DISCONNECT" 08980000
if sqlcode <> 0 then call rep_sqlca 'DISCONNECT' 08990000
return; 09000000
09010000
09020000
09030000
09040000
09050000
/*-------------------------------------------------------------------*/ 09060000
/* DB2 REXX Extensions initialisieren (DSNREXX) */ 09070000
/*-------------------------------------------------------------------*/ 09080000
init_dsnrexx: 09090000
if debug then say 'proc: init_dsnrexx' 09100000
if debug then say ' CONNSSID: 'connssid 09110000
09120000
/* check if DSNREXX functions are available */ 09130000
ADDRESS TSO 'SUBCOM DSNREXX'; 09140000
09150000
/* if not, then add DSNREXX functions to command table */ 09160000
IF RC=1 THEN S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX') 09170000
return; 09180000
09190000
09200000
09210000
/*-------------------------------------------------------------------*/ 09220000
/* DB2 REXX Extensions terminieren (DSNREXX) */ 09230000
/*-------------------------------------------------------------------*/ 09240000
exit_dsnrexx: 09250000
if debug then say 'proc: init_dsnrexx' 09260000
09270000
/* Remove the DSNREXX Functionality from command table */ 09280000
S_RC = RXSUBCOM('DELETE','DSNREXX','DSNREXX') 09290000
return; 09300000
09310000
09320000
09330000
/* ----------------------------------------------------------------- */ 09340000
/* Report SQLCA routine */ 09350000
/* - argument: func, is a text string that shold be used to identify */ 09360000
/* the location or function within the program */ 09370000
/* - return value: none */ 09380000
/* ----------------------------------------------------------------- */ 09390000
rep_sqlca: 09400000
arg func 09410000
say '-----------------------------------' 09420000
say 'Funktion= 'func 09430000
say 'SQLCODE = 'sqlcode 09440000
say 'SQLERRM = 'sqlerrmc 09450000
say 'SQLERRP = 'sqlerrp 09460000
say 'SQLERRD = 'sqlerrd.1',' || sqlerrd.2',', 09470000
|| sqlerrd.3',' || sqlerrd.4',', 09480000
|| sqlerrd.5',' || sqlerrd.6',' 09490000
say 'SQLWARN = 'sqlwarn.0',' || sqlwarn.1',', 09500000
|| sqlwarn.2',' || sqlwarn.3',', 09510000
|| sqlwarn.4',' || sqlwarn.5',', 09520000
|| sqlwarn.6',' || sqlwarn.7',', 09530000
|| sqlwarn.8',' || sqlwarn.9',', 09540000
|| sqlwarn.10 09550000
say 'SQLSTATE= 'sqlstate 09560000
return; 09570000
09580000