/* REXX FINDLIBS finds all material for all users identified on table @usr@ whose libraries end with any type specified on table @typ@. Produces a cross-reference table of datasets-by-member. Version 2: --not specific to REXX code --allow selection of users --create specific tables for specific uses See HELP-text: %findlibs ? |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke rexxhead@yahoo.com 20230517 Impact Analysis . SYSEXEC DIRSTATS . SYSEXEC DSVCSI . SYSEXEC SHOWLIBS . SYSEXEC TRAPOUT Modification History 20231016 fxc major re-write to accomodate Sam Golob suggestions for making it universally applicable; allow multiple user-tables, multiple type-tables, and multiple cross-ref-tables; 20231030 fxc better HELP-text; 20231116 fxc add HELP prompt on panel; 20240305 fxc align panel names; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; 20240610 fxc remove 2 unneeded panel attributes; */ arg argline address TSO /* REXXSKEL ver.20230514 */ address ISPEXEC "CONTROL ERRORS RETURN" arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = Trace(tv) info = parms /* to enable parsing */ call A_INIT /* Initialization -*/ if sw.0Error_Found then return call B_DEIMBED /* Set up panels -*/ CALL C_BUILD_USER /* Create/modify @usr@ -*/ call D_BUILD_TYPE /* Create/modify @typ@ -*/ call E_SEARCH /* Get list of datasets -*/ call M_MBRLIST /* get members -*/ call T_TABLE_OPS /* ISPEXEC stuff -*/ if sw.0Error_Found + sw.0KeepLog > 0 then, call ZB_SAVELOG /* -*/ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ FINDLIBS */ /* Initialization. Parse parameter string. . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call AL_SETUP_LOG /* -*/ logpref = "("BRANCH( 'ID' )")" parse value "0 0 0 0 0 0 0" with , mlist. dsns. . parse value "" with , userids types @usr@ @typ@ @xrf@ ddnlist log openmode. = "WRITE" openmode.1 = "NOWRITE" asof = Date( "S" ) asof = Translate( "CcYy-Mm-Dd", asof, "CcYyMmDd" ) sw.0KeepLog = SWITCH( "LOG" ) isptlib = KEYWD( "ISPTLIB" ) parse value KEYWD( "ISPTABL" ) isptlib with, isptabl . parse value KEYWD( "USERTBL" ) KEYWD( "TYPETBL" ) KEYWD( "XREFTBL" ), with @usr@ @typ@ @xrf@ . if isptlib = "" then isptlib = isptabl sw.0GetParms = Words( isptlib isptabl ) <> 2 |, Words( @usr@ @typ@ @xrf@ ) <> 3 utbl = @usr@ /* save as xvar */ ttbl = @typ@ /* save as xvar */ xtbl = @xrf@ if sw.0GetParms then, call AP_GET_PARMS /* Missing parameters -*/ return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AL_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 parse value "0 0 0 0 0" with, log# log. . parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Left( hhmmss,4 ) /* X141743 ? */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" vb4k.1 = "SHR" /* if it already exists... */ logdsn = "@LOG."exec_name"."subid".LIST" logpref = "("BRANCH( 'ID' )")" call ZL_LOGMSG( logpref exec_name, "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Arg:" argline ) return /*@ AL_SETUP_LOG */ /* Missing parameters. Pop a panel and collect what's missing. . ----------------------------------------------------------------- */ AP_GET_PARMS: /*@ */ if branch then call BRANCH address ISPEXEC call B_DEIMBED /* Set up panels -*/ do forever "DISPLAY PANEL( PARMS ) " if rc >= 8 then do sw.0Error_Found = 1 zerrsm = "Parm entry declined" zerrlm = "PF3 declines processing of parameters. ", "With inadequate parameters, processing cannot", "be successful. Process was halted." "SETMSG MSG( ISRZ002 )" return end /* PF3 */ if isptlib = "" then isptlib = isptabl if isptabl = "" then isptabl = isptlib if Pos( log,'yYnN' ) = 0 then log = 'N' if Words( isptlib isptabl ) = 2 &, Words( utbl ttbl xtbl ) = 3 then leave end /* forever */ upper log sw.0KeepLog = log = 'Y' parse value utbl ttbl xtbl with, @usr@ @typ@ @xrf@ . return /*@ AP_GET_PARMS */ /* Extract ISPF assets. . ----------------------------------------------------------------- */ B_DEIMBED: /*@ */ if branch then call BRANCH address ISPEXEC if ddnlist <> '' then return /* already done */ call DEIMBED /* Extract */ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd "LIBRARY ID("@ddn") STACK" end ddnlist = ddnlist dd return /*@ B_DEIMBED */ /* Attempt to TBOPEN @usr@. If unsuccessful, TBCREATE empty. Display @usr@ and allow corrections. At end, create variable . . ----------------------------------------------------------------- */ C_BUILD_USER: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" call ZL_LOGMSG( logpref "ISPTLIB set to" isptlib ) call CA_OPEN_USER /* Open existing or build new-*/ if \sw.0error_found then, call CS_SPIN_USER /* Create/modify @usr@ -*/ call CZ_DROP_USER /* Close and save -*/ return /*@ C_BUILD_USER */ /* . ----------------------------------------------------------------- */ CA_OPEN_USER: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" "TBSTATS" @usr@ "STATUS1(s1) STATUS2(s2)" if s1 > 1 then do zerrlm = "Table" @usr@ "not found in the ISPTLIB library chain" call ZL_LOGMSG( logpref zerrlm ) "TBCREATE" @usr@ "KEYS( USERID ) NAMES( USDATA ) WRITE REPLACE " end; else, if s2 = 1 then do /* table is not open */ "TBOPEN " @usr@ openmode.NOUPDT if rc > 4 then do zerrlm = "Table" @usr@ "cannot be opened due to prior", "enqueues." call ZL_LOGMSG( logpref zerrlm ) sw.0error_found = "1"; return end end else "TBTOP" @usr@ "TBSORT" @usr@ "FIELDS( USERID,C,A )" return /*@ CA_OPEN_USER */ /* . ----------------------------------------------------------------- */ CS_SPIN_USER: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" "TBTOP" @usr@ sel = "" do forever "TBDISPL" @usr@ "PANEL( UPDUSER )" if rc > 4 then leave if zcmd <> "" then do parse var zcmd verb text /* add u1 u2 u3... */ if verb = 'ADD' then, do while text <> '' parse var text userid text "TBMOD" @usr@ "ORDER" end /* text */ "TBTOP" @usr@ iterate end do ztdsels if Pos( sel,'dD' ) > 0 then, "TBDELETE" @usr@ if ztdsels > 1 then "TBDISPL" @usr@ end /* ztdsels */ sel = "" end /* forever */ "TBTOP" @usr@ userids = '' do forever "TBSKIP" @usr@ /* next row */ if rc > 0 then leave /* end of table */ userids = userids userid /* add to list */ end /* forever */ userids = Space( userids,1 ) call ZL_LOGMSG( logpref "Userids:" userids ) return /*@ CS_SPIN_USER */ /* . ----------------------------------------------------------------- */ CZ_DROP_USER: /*@ */ if branch then call BRANCH address ISPEXEC "TBCLOSE" @usr@ return /*@ CZ_DROP_USER */ /* . ----------------------------------------------------------------- */ D_BUILD_TYPE: /*@ */ if branch then call BRANCH address ISPEXEC call DA_OPEN_TYPE /* -*/ if \sw.0error_found then, call DD_SPIN_TYPE /* -*/ call DZ_DROP_TYPE /* -*/ return /*@ D_BUILD_TYPE */ /* . ----------------------------------------------------------------- */ DA_OPEN_TYPE: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" "LIBDEF ISPTLIB DATASET ID("isptlib") STACK" "TBSTATS" @typ@ "STATUS1(s1) STATUS2(s2)" if s1 > 1 then do zerrlm = "Table" @typ@ "not found in the ISPTLIB library chain" call ZL_LOGMSG( logpref zerrlm ) "TBCREATE" @typ@ "KEYS( TYPE ) WRITE REPLACE " end; else, if s2 = 1 then do /* table is not open */ "TBOPEN " @typ@ openmode.NOUPDT if rc > 4 then do sw.0error_found = 1 zerrlm = "Table" @typ@ "cannot be opened due to prior enqueues." call ZL_LOGMSG( logpref zerrlm ) return end end else "TBTOP" @typ@ "LIBDEF ISPTLIB" "TBSORT" @typ@ "FIELDS( TYPE,C,A )" return /*@ DA_OPEN_TYPE */ /* . ----------------------------------------------------------------- */ DD_SPIN_TYPE: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" "TBTOP" @typ@ sel = "" do forever "TBDISPL" @typ@ "PANEL( UPDTYPE )" if rc > 4 then leave if zcmd <> "" then do parse var zcmd verb text if verb = 'ADD' then, do while text <> '' parse var text type text "TBMOD" @typ@ "ORDER" end /* text */ iterate end do ztdsels if Pos( sel,'dD' ) > 0 then, "TBDELETE" @typ@ if ztdsels > 1 then "TBDISPL" @typ@ end /* ztdsels */ sel = "" end /* forever */ "TBTOP" @typ@ types = '' do forever "TBSKIP" @typ@ /* next row */ if rc > 0 then leave /* end of table */ types = types type /* add to list */ end /* forever */ call ZL_LOGMSG( logpref "Types:" types ) return /*@ DD_SPIN_TYPE */ /* . ----------------------------------------------------------------- */ DZ_DROP_TYPE: /*@ */ if branch then call BRANCH address ISPEXEC "TBCLOSE" @typ@ return /*@ DZ_DROP_TYPE */ /* is the list of all active users. is the list of all desired DS-tails . ----------------------------------------------------------------- */ E_SEARCH: /*@ */ if branch then call BRANCH address TSO e_tv = trace() /* what setting at entry ? */ rc = Trace("O") logpref = "("BRANCH( 'ID' )")" do Words( userids ) /* each user */ parse var userids usr userids "NEWSTACK" "DSVCSI" usr do queued() /* output from DSVCSI */ parse pull mode dsn . if mode <> 'NONVSAM' then iterate @RC = Listdsi( "'"dsn"' DIRECTORY") if sysdsorg <> "PO" then iterate parse value '0' with sw.0match w1 do Words( types ) /* each type */ parse value types w1 with w1 types ll = Length( w1 ) if Right( dsn,ll ) = w1 then sw.0match = 1 if sw.0match then leave end /* types */ types = types w1 /* restore */ if sw.0match then do parse value dsns.0+1 dsn with , @z dsns.@z 1 dsns.0 . call ZL_LOGMSG( logpref Right( @z,4 ) dsn ) end end /* queued */ "DELSTACK" end /* userids */ return /*@ E_SEARCH */ /* For each DSNS.x get memberlist queue mbr ds# Sort queue . ----------------------------------------------------------------- */ M_MBRLIST: /*@ */ if branch then call BRANCH address TSO m_tv = trace() /* what setting at entry ? */ logpref = "("BRANCH( 'ID' )")" parse value "ASOF UTBL TTBL" with xvars "NEWSTACK" do mx = 1 to dsns.0 /* each dsn */ ds = dsns.mx tag = "D"Right( mx,4,0 ) /* D0037 maybe */ rc = Value( tag,ds ) /* assign ds to tag */ xvars = xvars tag /* keep track */ "NEWSTACK" "DIRSTATS '"ds"'" do queued() pull mbr typ . if typ = "*ALIAS" then mbr = mbr"(*)" parse value mlist.0+1 Left( mbr,13 ) Right( mx,4,0 ) with , @z@ mlist.@z@ 1 mlist.0 . end /* queued */ "DELSTACK" end /* mx */ rc = Trace("O") rc = trace( m_tv ) "ALLOC FI(SORTIN) UNIT(VIO) RECFM(F B) SPACE(1 1) TRACK NEW REU", "LRECL(20) BLKSIZE(0)" "EXECIO" mlist.0 "DISKW SORTIN ( STEM MLIST. FINIS" "DELSTACK" /* restore prior queues */ zerrlm = "Starting sort," mlist.0 "items." call ZL_LOGMSG( logpref zerrlm ) rc = Outtrap("sort.") "ALLOC FI(SORTOUT) REFDD(SORTIN) NEW REU" "ALLOC FI(SYSOUT) DUMMY REU " "ALLOC FI(SYSIN) NEW TRACKS SPACE(1) UNIT(VIO)", "LRECL(80) BLKSIZE(800) RECFM(F B) REU" push " SORT FIELDS=(1,20,CH,A)" "EXECIO 1 DISKW SYSIN (FINIS" sortprm = "MSG=CC" /* suppress messages */ address LINKMVS "SORT sortprm" "EXECIO * DISKR SORTOUT (STEM MLIST. FINIS" zerrlm = "SORT delivered" mlist.0 "lines." call ZL_LOGMSG( logpref zerrlm ) "FREE FI(SORTIN SORTOUT SYSOUT)" "ALLOC FI(SYSIN) DA(*) SHR REU" rc = Outtrap("off") return /*@ M_MBRLIST */ /* . ----------------------------------------------------------------- */ T_TABLE_OPS: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" /* Detach all the ISPF assets */ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd address TSO "FREE FI("@ddn")" end ddnlist = ddnlist dd call TB_BUILD_TABLE /* DSNs-by-Member -*/ address TSO "SHOWLIBS FROM" @xrf@ , /* -*/ "ISPTLIB" isptlib return /*@ T_TABLE_OPS */ /* xvars is already set Process sorted queue: Compile ds# for each member TBADD Display table . ----------------------------------------------------------------- */ TB_BUILD_TABLE: /*@ */ if branch then call BRANCH address ISPEXEC logpref = "("BRANCH( 'ID' )")" parse value "" with dsindx "TBCREATE " @xrf@ "KEYS( DSMBR ) NAMES( DSCT DSINDX ) WRITE REPLACE " dsmbr = '3f3f'x /* admin row */ "TBADD " @xrf@ "SAVE(" xvars ")" parse var mlist.1 dsmbr . do tx = 1 to mlist.0 /* each SORTOUT */ parse var mlist.tx mbr ds# /* */ if mbr <> dsmbr then do /* break */ dsindx = Space( dsindx,1 ) /* compress */ dsct = Words( dsindx ) "TBADD " @xrf@ parse value mbr with dsmbr dsindx end /* break */ dsindx = dsindx ds# end /* tx */ dsindx = Space( dsindx,1 ) /* compress */ dsct = Words( dsindx ) "TBADD " @xrf@ "LIBDEF ISPTABL DATASET ID("isptabl") STACK" if noupdt then "TBEND " @xrf@ /* don't save */ else "TBCLOSE" @xrf@ "LIBDEF ISPTABL" return /*@ TB_BUILD_TABLE */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* Parse out the embedded components at the back of the source code. . ----------------------------------------------------------------- */ DEIMBED: Procedure expose, /*@ */ (tk_globalvars) ddnlist @ddn. daid. address TSO fb80po.0 = "NEW DELETE REU UNIT(SYSDA) SPACE(1 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" fb80po.1 = "SHR REU" parse value "" with ddnlist @ddn. daid. lastln = sourceline() currln = lastln /* */ if Left(sourceline(currln),2) <> "*/" then return currln = currln - 1 /* previous line */ "NEWSTACK" address ISPEXEC do while sourceline(currln) <> "/*" text = sourceline(currln) /* save with a short name ! */ if Left(text,3) = ")))" then do /* package the queue */ parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */ if length(ddn) > 4 then do /* data, not ISPF */ call DESPOOL /* -*/ currln = currln - 1 /* previous line */ iterate end if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random(999) /* PLIB322 maybe */ @ddn.ddn = @ddn /* @ddn.PLIB = PLIB322 */ address TSO "ALLOC FI("@ddn")" fb80po.0 "LMINIT DATAID(DAID) DDNAME("@ddn")" daid.ddn = daid end daid = daid.ddn "LMOPEN DATAID("daid") OPTION(OUTPUT)" do queued() parse pull line "LMPUT DATAID("daid") MODE(INVAR) DATALOC(LINE) DATALEN(80)" end "LMMADD DATAID("daid") MEMBER("mbr")" "LMCLOSE DATAID("daid")" end /* package the queue */ else push text /* onto the top of the stack */ currln = currln - 1 /* previous line */ end /* while */ address TSO "DELSTACK" return /* Subroutine of DEIMBED for non-ISPF data. Given : the stack, ddn, and mbr . ----------------------------------------------------------------- */ DESPOOL: /*@ */ if branch then call BRANCH address TSO if WordPos( ddn,ddnlist ) = 0 then, ddnlist = Space( ddnlist ddn,1 ) if Sysdsn(ddn".DATA") <> "OK" then, "ALLOC FI("ddn") DA("ddn".DATA)" fb80po.0 "ALLOC FI("ddn") DA("ddn".DATA("mbr")) SHR REU" "EXECIO" queued() "DISKW" ddn "(FINIS" "DELSTACK" "NEWSTACK" /* re-establish */ return /*@ DESPOOL */ return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ "ALLOC FI(@LOG) DA("logdsn") REU" vb4k.0 "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI(@LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# msglim rc = Trace("O") address TSO parse arg msgtext /* for making the msgline always reasonably short: */ do while Length(msgtext) > msglim pt = LastPos(" ",msgtext,msglim) slug = Left(msgtext,pt) if monitor then say, slug parse value log#+1 slug with, zz log.zz 1 log# . msgtext = " "Substr(msgtext,pt) end /* while msglim */ parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" locates all libraries matching certain criteria for " say " selected userids on the system and generates a " say " cross-reference table of all membernames that exist " say " in any selected library. " say " " say " Syntax: "ex_nam" ISPTLIB tbldsni " say " ISPTABL tbldsno " say " LOG " say " USERTBL utblnm (Required)" say " TYPETBL ttblnm (Required)" say " XREFTBL xtblnm (Required)" "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " tbldsni names an input ISPTLIB dataset to supply existing " say " copies (if any) of pertinent tables. Necessary " say " tables will be created anew if they do not exist, " say " and populated by an internal dialog. At least one " say " of and must be supplied. " say " " say " tbldsno names an output ISPTABL dataset to receive the " say " (re)generated tables. At least one of and" say " must be supplied. " say " " say " LOG The log file is kept if there has been an error in " say " processing or if 'LOG' is specified. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " utblnm names the table to contain the list of userids to be" say " inventoried. is read from ISPTLIB if it " say " exists and is written to ISPTABL at process-end. " say " " say " ttblnm names the table to contain the list of dataset " say " trailing nodes. Typically, these are low-level " say " qualifiers. Only the trailing characters of dataset" say " names participate in matching. is read " say " from ISPTLIB if it exists and is written to ISPTABL " say " at process-end. " say " " say " xtblnm names the cross-reference table to contain the list " say " of unique member names with information about their " say " associated dataset names. This table will be the " say " primary input to SHOWLIBS. is read from " say " ISPTLIB if it exists and is written to ISPTABL at " say " process-end. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " " say " NOUPDT: by-pass all update logic. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution " say " into REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example: " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sw.0inispf then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")", info if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")", info if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.0nested = sysvar("SYSNEST") = "YES" sw.0batch = sysvar("SYSENV") = "BACK" sw.0inispf = sysvar("SYSISPF") = "ACTIVE" if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */ /* ))) PLIB PARMS Collect parameters )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( LOW ) CAPS( ON ) @ TYPE( TEXT ) INTENS( HIGH ) COLOR( YELLOW ) } TYPE( INPUT ) INTENS( HIGH ) COLOR( YELLOW ) ! TYPE( INPUT ) INTENS( NON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) @|-|% Specify parameter values @|-| %COMMAND ===>_ZCMD %SCROLL ===>_ZAMT+ + %PF1 for HELP + Input ISPF Table Library ===>}isptlib + Output ISPF Table Library ===>}isptabl + + USER Table name ===>}utbl + + TYPE Table name ===>}ttbl + + XREF Table name ===>}xtbl + + + Produce LOG file ===>}z+ %(Y or N)+ + )INIT .ZVARS = '( LOG )' .HELP = PARMSH )PROC )END ))) PLIB PARMSH Help collect parameters )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| Specify parameter values |-| TUTORIAL %Next Selection ===>_ZCMD + + All fields shown are required. Known values have been entered on the panel + already. Supply values for all items:%INput+table library,%OUTput+table + library (if different), tables for%USERids, TYPEs,+and the (output)%cross reference.+ + Dataset names should be entered in TSO-format: quoted if fully-qualified. + + You may choose to produce a LOG file or not. )PROC &ZUP = PARMSH &ZCONT = PARMSH )END ))) PLIB UPDUSER Create/modify USERTBL )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %|-| Create/modify USERTBL +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ +Table name!@usr@ +V Userid %PF1 for HELP )MODEL _z!userid + )INIT .ZVARS = '(SEL)' .HELP = UPDUSERH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB UPDUSERH HELP for UPDUSER )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| Create/modify USERTBL |-| TUTORIAL %Next Selection ===>_ZCMD + USERIDs are used to filter dataset names. If a given USERID is on the table, that user's datasets are inventoried for downstream processing: specifically, they are later filtered by TYPE. Select any row with%D+to delete the selected userid from the table. Command%ADD+with a list of userids to add to the table: %===> add user1 user2 user3 user4 ... usern+ )PROC &ZUP = UPDUSERH &ZCONT = UPDUSERH )END ))) PLIB UPDTYPE Create/modify TYPETBL )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %|-| Create/modify TYPETBL +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ Table name!@typ@ +V Type %PF1 for HELP )MODEL _z!type )INIT .ZVARS = '(SEL)' .HELP = UPDTYPEH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB UPDTYPEH HELP for UPDTYPE )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| Create/modify TYPETBL |-| TUTORIAL %Next Selection ===>_ZCMD + TYPEs are used to filter dataset names. Datasets that end with any character string among the list of TYPEs in this table will be selected for further processing. Mismatched datasets are ignored. Select any row with%D+to delete the selected type from the table. Command%ADD+with a list of types to add to the table: %===> add .type1 .type2 .type3 .type4 ... .typen+ The follow-on processing for selected datasets is to acquire a member list and associate each member to its dataset name. Finally, the compiled list of member names is presented for selection. For member names that appear in more than one dataset, all the associated datasets are then presented for further selection. )PROC &ZUP = UPDTYPEH &ZCONT = UPDTYPEH )END */