/* REXX TBLSTATS Populate the ISPF statistics of an ISPTLIB dataset with membername, create-date, last-chg-date, last-chg-time, rows, and last-chg-user. Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com with an assist by Chris Lewis, GTEDS. Impact Analysis . SYSEXEC MEMBERS . SYSEXEC TRAPOUT . SYSEXEC UPOE Modification History 19970608 fxc upgrade from v.950824 to v.970326; 20020128 fxc upgrade from v.970326 to v.20010730; RXSKLY2K; 20160713 fxc switch to 4-digit years; other minor chgs 20230407 fxc adjust HELP 20230408 fxc enable true generic memberspec 20230417 fxc adjust HELP; 20240520 fxc make it work from a memberlist; 20241107 fxc force LASTUSER from memberlist; 20250330 fxc enable UID to override user setting; 20250925 fxc SPACEOUT; new BACKEND; */ arg argline address TSO /* REXXSKEL ver.20010730 */ 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 */ if monitor then address TSO "CLEAR" call A_INIT /* local initialization -*/ call B_GET_STATS /* populate statistics -*/ exit /*@ TBLSTATS */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO forceuser = KEYWD( "UID" ) parse var info tbldsn memspec if Sysdsn( tbldsn ) <> "OK" then do helpmsg = "No valid datasetname found in parameter list." call HELP /* ...and don't come back -*/ end if Pos( '(',tbldsn ) > 0 then do /* dsn( mbr ) */ parse var tbldsn tbldsn "(" memspec ")" sw.0Use_TBLSTATS = 1 end if Left( tbldsn,1 ) = "'" then, /* quoted */ tbldsn = Strip( tbldsn,,"'" ) else tbldsn = Userid()"."tbldsn parse value "0 0 0 0 0 0 0 0 0" with, rowct maskl . return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ B_GET_STATS: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" /* isolate queue */ "MEMBERS '"tbldsn"' ((STACK LINE" pull mbrlist "DELSTACK" /* restore existing queue */ if memspec <> "" then do if Pos( "*",memspec ) > 0 then do parse var memspec memspec . /* just one */ if Pos( "*",memspec ) = 0 then do helpmsg = "Too many membernames. ", "When a generic specification is used, it", "must be the ONLY member specification." call HELP /* ...and don't come back -*/ end sw.0partial = 1 maskl = Length( memspec ) lomask = Translate( memspec, '00'x , "*" ) himask = Translate( memspec, 'FF'x , "*" ) w1 = '' do Words( mbrlist ) /* each member */ parse value mbrlist w1 with w1 mbrlist if BitAnd( himask,Left( w1,maskl ) ) <> , BitOr( lomask,Left( w1,maskl ) ) then, w1 = '' /* no match, discard */ end /* each member */ mbrlist = mbrlist w1 /* restore last */ end /* asterisks */ else, /* no asters in memspec */ mbrlist = memspec /* real members */ end /* memspec not empty */ if monitor then say, "Member list:" mbrlist address ISPEXEC "LIBDEF ISPTLIB DATASET ID( '"tbldsn"' )" do while mbrlist <> "" /* for each member */ parse var mbrlist mbr mbrlist if monitor then say, "Processing" mbr drop updatetm address ISPEXEC, "TBSTATS" mbr "CDATE4D( createdt )", "UDATE4D( updatedt )", "UTIME( updatetm )", "USER( lastuser )", "ROWCURR( rowct )" parse value forceuser lastuser with lastuser . if rc > 0 then do /* something's wrong... */ if monitor then say, mbr "skipped, rc="rc iterate end else do rowct = rowct + 0 /* drop leading zeroes */ if sw.0Use_TBLSTATS then, lastuser = "TBLSTATS" updatetm = Left( updatetm,5 ) updatetm = Translate( updatetm , ":" , "." ) "UPOE" mbr tbldsn "99 99" createdt updatedt, updatetm rowct rowct "0" lastuser, "(( TRACE" tv end end /* mbrlist */ address ISPEXEC "LIBDEF ISPTLIB" return /*@ B_GET_STATS */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left( exec_name,8 ) /* predictable size */ say " " say " "ex_nam" Populate the ISPF statistics for an ISPTLIB dataset with " say " membername, create-date, last-chg-date, last-chg-time, " say " rows, and last-chg-user. " say " " say " Syntax: "ex_nam" tbldsn (Required)" say " mbrspec " say " UID utag " say " " say " tbldsn (quoted if fully-qualified). The table library to " say " be worked. If includes a member, that " say " single member will override and the userid" say " in the stats will be 'TBLSTATS' regardless of any " say " setting via UID. " say " " say " mbrspec limits the action of "ex_nam" to the member(s) " say " specified or implied. May be a single generic " say " member name or one or more member names. " say " " say " utag specifies a particular userid to use when setting " say " the statistics. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " Displays most paragraph names upon entry. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place " say " the execution in 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" (( trace ?r branch " if sysvar( "SYSISPF" ) = "ACTIVE" 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 ) /* 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( '5d40'x,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','5d'x ) /* 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" parse value KEYWD( "TRACE" ) "N" with tv . 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 . 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 */