Return to Mainframe Utilities Page
Module
/* rexx */
/**********************************************************************/
/* Library clean utiltity. Compare the directories of two PDS'. */
/* Optionally delete members, compare members, etc. */
/* */
/* Written by: Rob Wunderlich 4/93 */
/* */
/*MM/YY VER WHO */
/*----- --- --- */
/*02/95 1.3 DAL Added EN and EO commands to edit members and improved */
/* the leap year logic and added vputs to main panel */
/* to save dataset names in the pool. */
/*03/94 1.2 RBW Added logic to disallow commands against "OLD" lib */
/* when using an unmatched list. */
/*03/94 1.1 RBW Distributed Public Domain version 1.1. */
/**********************************************************************/
lc_version = '1.3' /* LIBCLEAN version */
/* * * * Establish Error Traps * * * * * */
call on error name errproc
call on failure name errproc
signal on syntax name errproc
signal on novalue name errproc
signal on halt name haltproc
address ispexec "control errors return"
/**********************************************************************/
/* */
/**********************************************************************/
/* if left(sysvar('SYSUID'),3) ¬= 'WTS'
then do
say 'You not authorized to use LIBCLEAN'
exit 8
end */
flag = ''
newsize = ''; newdate = ''; newid = 'LMOD'
oldsize = ''; olddate = ''; oldid = 'LMOD'
disp_restore = 0
alloc_done = 0
delcount = 0
matchcnt = 0
sysmembers = 0
input_count = 0
get_out = 0
do forever
address ispexec
ok='0 8';"DISPLAY PANEL(LIB@CLN1)"
if rc = 8
then exit
if matchopt = 'U' /* If option unmatched, */
then oldid = '' /* then clear default id */
if matchopt = 'M'
then matchtxt = ' Matches:'
else matchtxt = 'Nonmatches:'
rc = LISTDSI(newdsn 'DIRECTORY')
statmsg = 'Member list compare in progress...'
"CONTROL DISPLAY LOCK"
"DISPLAY PANEL( )" /* tell user work is in progress */
ok=0;"TBCREATE MEMTBL NOWRITE KEYS(MEMBER)" ,
"NAMES(NEWSIZE OLDSIZE NEWDATE OLDDATE NEWID OLDID FLGDATE)"
ok=0;"LMINIT DATAID(OLDLIB) DATASET("olddsn") ENQ(SHRW)"
ok=0;"LMINIT DATAID(NEWLIB) DATASET("newdsn") ENQ(SHRW)"
ok=0;"LMOPEN DATAID("oldlib") OPTION(INPUT) RECFM(ORECFM) ORG(OORG)"
ok=0;"LMOPEN DATAID("newlib") OPTION(INPUT) RECFM(NRECFM) ORG(NORG)"
if oorg ¬= 'PO' ¦ norg ¬= 'PO'
then do
say '*** ERROR - NewLib or OldLib not partitioned.'
call cleanup_after_error
end
if orecfm = 'U' ¦ nrecfm = 'U'
then if lmodstat = 'Y'
then do
ok=0;address tso "ALLOC FI(OLDLIBDD) DA("olddsn") SHR REUSE"
ok=0;address tso "ALLOC FI(NEWLIBDD) DA("newdsn") SHR REUSE"
alloc_done = 1
end
else nop
member = '' /* */
end_of_list = 0 /* Reset end of member list indicator */
do until end_of_list /* Do for each member */
ok='0 8';"LMMLIST DATAID("newlib") MEMBER(MEMBER) STATS(YES)"
mlist_rc = rc
input_count = input_count + 1
if input_count // 10 = 0
then do
statmsg2 = 'Member' input_count 'of' sysmembers ,
'-' strip(matchtxt,'L') matchcnt
"CONTROL DISPLAY LOCK"
"DISPLAY PANEL( )" /* tell user work is in progress */
end
if mlist_rc = 0
then do /* We have a member from newlib */
if left(nrecfm,2) = 'FB'
then do
newsize = zlcnorc
newdate = zlmdate
newid = zluser
end
ok='0 8';"LMMFIND DATAID("oldlib") MEMBER("member") STATS(YES)"
if rc = 0 /* Set flag re member found */
then oldmem_match = 1
else oldmem_match = 0
if oldmem_match & matchopt = 'M' /* If found and looking for */
then do /* matches */
if left(orecfm,2) = 'FB' /* Get oldmem stats */
then do
oldsize = zlcnorc
olddate = zlmdate
oldid = zluser
end
else if lmodstat = 'Y'
then do
ok=0;address tso "FINDMEM" member "OLDLIBDD"
oldsize = right(c2x(substr(fmdirent,25,3)),6,'0')
olddate = jul2greg(fmlkeddt)
end
else nop
end /* End of oldmem stats */
/* Common actions section */
if oldmem_match & matchopt = 'M' ¦,
ªoldmem_match & matchopt = 'U'
then do
if lmodstat = 'Y' & nrecfm = 'U'
then do
ok=0;address tso "FINDMEM" member "NEWLIBDD"
newsize = right(c2x(substr(fmdirent,25,3)),6,'0')
newdate = jul2greg(fmlkeddt)
end
matchcnt = matchcnt + 1
ok=0;"TBADD MEMTBL"
if olddate = '' ¦ newdate = '' /* If missing old or new date */
then flgdate = '' /* then skip test */
else do
if olddate > newdate
then flgdate = '>'
else flgdate = ''
end
end /* End of common actions section */
end
if mlist_rc = 8 then end_of_list = 1 /* Indicate no more members */
end /* End of do until end_of_list */
ok='0 8';"LMMLIST DATAID("newlib") OPTION(FREE)"
ok=0;"LMCLOSE DATAID("newlib")"
ok=0;"LMCLOSE DATAID("oldlib")"
ok=0;"LMOPEN DATAID("newlib") OPTION(OUTPUT)"
ok=0;"LMOPEN DATAID("oldlib") OPTION(OUTPUT)"
ok=0; address ispexec "TBTOP MEMTBL"
do forever
ok='0 4 8';address ispexec "TBDISPL MEMTBL PANEL(LIB@CLN2)"
if rc = 8 then leave
i = ztdsels /* Number of selected rows */
do i /* Do for all selected rows */
call process_linecmd /* Go process entered line commands */
if ztdsels > 1 /* If more than one row selected */
then do /* then go fetch the next row */
ok='0 4 8';"TBDISPL MEMTBL"
end
end
if zcmd ¬= '' then call process_zcmd /* If entry in COMMAND line */
if get_out
then leave
ok='0 8';"TBSKIP MEMTBL ROW("ztdtop")" /* Set top display row */
end
ok=0;address ispexec "TBEND MEMTBL"
ok=0;"LMCLOSE DATAID("oldlib")"
ok=0;"LMFREE DATAID("newlib")"
ok=0;"LMFREE DATAID("oldlib")"
zedsmsg = delcount "members deleted"
zedlmsg = ''
ok=0;"SETMSG MSG(ISRZ000)"
end
exit
/**********************************************************************/
/* Line Command Routine */
/**********************************************************************/
process_linecmd:
linecmd = strip(linecmd,'B','_')
member = strip(member,'B')
if matchopt = 'M'
then, /* Linecmds for MATCHED */
valid_linecmds = 'BN BO C DN DO EN EO S X'
else, /* Linecmds for UNMATCHED */
valid_linecmds = 'BN DN EN S X'
do while wordpos(linecmd,valid_linecmds) = 0 /* Valid line cmds */
ok = 0;"ADDPOP ROW(7) COLUMN(10)" /* Set popup mode */
ok='0 8';"DISPLAY PANEL(LIB@CLN4)" /* Display command selections*/
save_rc = rc /* Save return code */
ok=0;"REMPOP" /* Clear popup mode */
if save_rc = 8 /* If user pressed END */
then return /* then return to caller */
linecmd = strip(linecmd,'B','_')
end
select
when linecmd = 'BO' ¦ linecmd = 'BN'
then do
ok=0;"CONTROL DISPLAY SAVE" /* save display environment */
disp_restore = 1 /* restore required */
if linecmd = 'BO'
then "BROWSE DATAID("oldlib") MEMBER("member")"
else "BROWSE DATAID("newlib") MEMBER("member")"
ok=0;"CONTROL DISPLAY RESTORE" /* restore display env */
disp_restore = 0
end
when linecmd = 'C' /* Compare members */
then do
if orecfm = 'U' ¦ nrecfm = 'U'
then cp_ctype = 'BYTE'
else cp_ctype = 'LINE'
if right(olddsn,1) = "'" /* If quoted dsname, */
then x = length(olddsn) - 1 /* then set insert position */
else x = length(olddsn) /* else insert after dsname */
old_dsname = insert("("member")",olddsn,x)
ok=0; address tso,
"ALLOC FI(OLDDD) DA("old_dsname") SHR REUSE"
if right(newdsn,1) = "'" /* If quoted dsname, */
then x = length(newdsn) - 1 /* then set insert position */
else x = length(newdsn) /* else insert after dsname */
new_dsname = insert("("member")",newdsn,x)
ok=0; address tso,
"ALLOC FI(NEWDD) DA("new_dsname") SHR REUSE"
compare_outdd_fname = "'"userid()".SUPERC.LIST'"
call msg 'OFF'
ok='*'; address tso,
"ALLOC FI(OUTDD) DA("compare_outdd_fname") OLD REUSE"
call msg 'ON'
if rc > 0
then do
ok=0; address tso,
"ALLOC FI(OUTDD) DA("compare_outdd_fname") NEW REUSE",
"DSORG(PS) RELEASE SPACE(50 100) BLKSIZE(3325)"
end
ok=0; address tso,
"ALLOC FI(SYSIN) DUMMY REUSE"
/* Invoke SuperC */
ok='*';"SELECT PGM(ISRSUPC) PARM(DELTAL,LINECMP,)"
ok=0;"CONTROL DISPLAY SAVE" /* Save display environ */
disp_restore = 1 /* Indicate RESTORE required */
ok=0;"BROWSE DATASET("compare_outdd_fname")" /* Browse output */
ok=0;"CONTROL DISPLAY RESTORE" /* Restore display */
disp_restore = 0 /* Reset restore flag */
ok=0; address tso,
"FREE FI(OUTDD,SYSIN,OLDDD,NEWDD)"
end /* End of Compare line command */
when linecmd = 'DO' ¦ linecmd = 'DN'
then do
ok=0;
if linecmd = 'DO'
then "LMMDEL DATAID("oldlib") MEMBER("member")"
else "LMMDEL DATAID("newlib") MEMBER("member")"
delcount = delcount + 1
ok=0;"TBDELETE MEMTBL" /* Delete the row */
/* If the following TBSKIP is not done, the wrong row may be deleted */
ok='0 8';"TBSKIP MEMTBL NUMBER(0)" /* Refetch the vars */
end
when linecmd = 'EO' ¦ linecmd = 'EN'
then do
ok=0;"CONTROL DISPLAY SAVE" /* save display environment */
disp_restore = 1 /* restore required */
if linecmd = 'EO' then do
ok='0 4 8';"EDIT DATAID("oldlib") MEMBER("member")"
end
else do
ok='0 4 8';"EDIT DATAID("newlib") MEMBER("member")"
end
ok=0;"CONTROL DISPLAY RESTORE" /* restore display env */
disp_restore = 0
end
when linecmd = 'S'
then do
if ªalloc_done
then do
ok=0;address tso "ALLOC FI(NEWLIBDD) DA("newdsn") SHR REUSE"
ok=0;address tso "ALLOC FI(OLDLIBDD) DA("olddsn") SHR REUSE"
alloc_done = 1
end
if nrecfm = 'U'
then do
ok=0;address tso "FINDMEM" member "NEWLIBDD"
newsize = right(c2x(substr(fmdirent,25,3)),6,'0')
newdate = jul2greg(fmlkeddt)
end
if orecfm = 'U'
then do
ok=0;address tso "FINDMEM" member "OLDLIBDD"
oldsize = right(c2x(substr(fmdirent,25,3)),6,'0')
olddate = jul2greg(fmlkeddt)
end
if olddate > newdate
then flgdate = '>'
else flgdate = ''
ok=0;"TBPUT MEMTBL" /* Update the row */
end
when linecmd = 'X'
then do
ok=0;"TBDELETE MEMTBL" /* Delete the row */
/* If the following TBSKIP is not done, the wrong row may be deleted */
ok='0 8';"TBSKIP MEMTBL NUMBER(0)" /* Refetch the vars */
end
otherwise nop;
end
return
/**********************************************************************/
/* Primary Command Routine */
/**********************************************************************/
process_zcmd:
parse var zcmd zcmd oper
upper oper
select
when zcmd = 'DELETE'
then do
if matchopt = 'U' /* If Unmatched list, then*/
then oper = 'NEW' /* force delete from NEW */
do while wordpos(oper,'NEW OLD') = 0 /* Valid operands */
ok = 0;"ADDPOP ROW(7) COLUMN(10)" /* Set popup mode */
ok='0 8';"DISPLAY PANEL(LIB@CLN5)" /* Display oper prompt */
save_rc = rc /* Save return code */
ok=0;"REMPOP" /* Clear popup mode */
if save_rc = 8 /* If user pressed END */
then return /* then return to caller */
end
if oper = 'OLD'
then deldsn = olddsn
else deldsn = newdsn
ok=0;"ADDPOP ROW(8) COLUMN(15)" /* POSITION THE POP UP */
ok=0;"DISPLAY PANEL(LIB@CLN3)"
save_rc = rc
ok=0;"REMPOP" /* Remove the popup */
if uconfirm ¬= 'Y' ¦ save_rc > 0
then do
zedsmsg = 'Delete cancelled'
zedlmsg = 'Delete was cancelled at your request.'
ok=0;"SETMSG MSG(ISRZ001)"
end
else do
if oper = 'OLD'
then dellib = oldlib
else dellib = newlib
ok=0;"TBTOP MEMTBL" /* Set table to top */
do until rc = 8
ok='0 8';"TBSKIP MEMTBL NUMBER(1)" /* Read table row */
if rc = 0 /* If a row was read */
then do
ok=0;"LMMDEL DATAID("dellib") MEMBER("member")"
delcount = delcount + 1
if delcount // 10 = 0
then do
ok=0;"CONTROL DISPLAY LOCK"
ok=0;"DISPLAY PANEL( )"
end
end
end
get_out = 1
end
end
when abbrev('LOCATE',zcmd,1)
then do
ok=0;"TBTOP MEMTBL"
member = oper
ok=0;"TBSCAN MEMTBL ARGLIST(MEMBER)" ,
"CONDLIST(GE)"
end
/* 'VERsion' command. Display EXEC version number */
when abbrev('VERSION',zcmd) /* If version cmd */
then do
zedsmsg = 'LIBCLEAN version' lc_version
zedlmsg = ''
ok=0;"SETMSG MSG(ISRZ000)" /* display messages */
end
otherwise do
zedsmsg = 'Invalid command'
zedlmsg = '"'zcmd'" is not a recognized primary command.' ,
'Valid commands are DELETE.'
ok=0;"SETMSG MSG(ISRZ001)"
end
end
return
/**********************************************************************/
/* Halt routine */
/**********************************************************************/
haltproc:
signal off syntax
signal off novalue
call off error
call off failure
call cleanup_after_error
exit
/**********************************************************************/
/* Function to convert julian date to gregorian */
/**********************************************************************/
jul2greg:
procedure
parse arg date
days.1 = 31
days.2 = 28
days.3 = 31
days.4 = 30
days.5 = 31
days.6 = 30
days.7 = 31
days.8 = 31
days.9 = 30
days.10 = 31
days.11 = 30
days.12 = 31
/*** julian to gregorian conversion ***/
year = substr(date,1,2)
day = substr(date,3)
julian = day
/* validate input */
if verify(date,'0123456789') ¬= 0
then do
say 'Invalid characters in julian date'
exit 8
end
if year // 100 = 0
then if year // 400 = 0
then max_julday = 366
else max_julday = 365
else if year // 4 = 0
then max_julday = 366
else max_julday = 365
if day < 1 ¦ day > max_julday
then do
say 'Invalid value for julian day'
exit 8
end
/* input is ok. Calculate gregorian */
if year // 100 = 0
then if year // 400 = 0
then days.2 = 29
else nop
else if year // 4 = 0
then days.2 = 29
else nop
month = 1
do while day > days.month
day = day - days.month
month = month + 1
end
date = right(year,2,'0')¦¦'/'¦¦right(month,2,'0')¦¦'/'¦¦right(day,2,'0')
return date /* return to caller */
/**********************************************************************/
/* Cleanup after error */
/**********************************************************************/
cleanup_after_error:
"LMCLOSE DATAID("newlib")"
"LMCLOSE DATAID("oldlib")"
"LMFREE DATAID("newlib")"
"LMFREE DATAID("oldlib")"
"TBEND MEMTBL"
if disp_restore
then "CONTROL DISPLAY RESTORE"
exit
/*********************************************************************/
/** standard error handling routine **/
/*********************************************************************/
errproc:
if (condition('c') = 'ERROR' ¦ condition('c') = 'FAILURE') ,
& symbol('OK') = 'VAR'
then if wordpos(rc,ok) > 0 ¦ ok = '*' then return; /* Not an error*/
/* Cancel error traps to prevent recursion */
signal off syntax
signal off novalue
call off error
call off failure
/* error presentation code */
error_type = condition('c')
say error_type 'at line' sigl ':' condition('d')
if error_type = 'SYNTAX'
then say errortext(rc)
if (error_type = 'ERROR' ¦ error_type = 'FAILURE') ,
& symbol('zerrlm') = 'VAR'
then say zerrlm
if error_type = 'ERROR' ¦ error_type = 'FAILURE'
then say 'Return code = ' rc
call cleanup_after_error
Documentation
LIBCLEAN is a "shareware" utility I loaded from the NASCOM BBS. The
provided documentation is as follows:
LIBCLEAN is a REXX ISPF dialog that compares the directories of two PDS
libraries and displays a list of matching or non-matching member names
and statistics. Only non-load libraries are supported.
Operations such as browse, compare, or delete may then be performed
against members in the list. All listed members may be mass deleted
from either the OLD or NEW library. Selected members may be excluded
from the mass delete.
This tool can be useful for deleting duplicate copies of software when
the product is in a mixed library. It is a very fast way to clean up
messy ISPF files. It can also be used to verify source members exist
for a load library.
Invoking LIBCLEAN
------------------
Enter TSO %LIBCLEAN
Enter library names as directed on the initial panel. LIBCLEAN will
then build the matched or unmatched list.
Sorry...no help screens yet.
Line commands
-------------
Any unrecognized line command, e.g. '?' will display a list of valid
line commands.
The following line commands are provided:
- BO / BN - Browse member from the OLD lib (BO) or the NEW lib (BN).
- C - Invoke IBM SuperCompare with the members from NEW and OLD libs.
- DO / DN - Delete member from the OLD lib (DO) or the NEW lib (DN).
- EO / EN - Edit member from the OLD lib (BO) or the NEW lib (BN).
- S - Show Load module stats for the member. Requires the FINDMEM CP.
- X - EXclude the member from the list. Use this to exclude members
from the mass DELETE primary command.
Primary commands
----------------
The following primary commands are provided:
- DELETE OLD
- DELETE NEW Delete all members on list from OLD or NEW lib. This
will be followed by a delete confirmation panel.
- Locate xxx Position the list to member xxx.