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.