/* REXX UPOE Will update the stats and TBMOD the table Use '(routine name) ?' for HELP-text. Written by Chris Lewis 19950308 Impact Analysis . SYSEXEC TRAPOUT Modification History 19950426 ctl Added DDNAME to pull in parms b/c of rewrite to SHOW@MEM 20000208 fxc rigged to use 4-digit-year dates; RXSKLY2K; 20070517 fxc revamp; 20230726 fxc adjust HELP; 20241107 fxc allow 8-character userids; 20250810 fxc adjust HELP; 20250812 fxc correct setting of ; added MONITORing; 20250925 fxc SPACEOUT; new BACKEND; */ arg argline address TSO /* REXXSKEL ver.20040227 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ if monitor then say "Argline = "argline rc = Trace( "O" ); rc = Trace( tv ) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_RESTAT /* -*/ if \sw.0nested then call DUMP_QUEUE /* -*/ exit /*@ UPOE */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse var parms memname dataset vv mm created changed, time size init mod id . if Left( dataset,1 ) = "'" then, dataset = Strip( dataset,,"'" ) else, dataset = Userid()'.'dataset if monitor then say "Using dataset" dataset return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ B_RESTAT: /*@ */ if branch then call BRANCH address ISPEXEC "LMINIT DATAID( BASEID ) DATASET( '"dataset"' )" if rc > 0 then do zerrlm = lminit.rc "SETMSG MSG( ISRZ002 )" sw.0error_found = 1 return end "LMOPEN DATAID( &BASEID )" if rc > 0 then do zerrlm = lmopen.rc "SETMSG MSG( ISRZ002 )" sw.0error_found = 1 return end "LMMSTATS DATAID( "baseid" )" "MEMBER( "memname" )", "VERSION( "vv" )" "MODLEVEL( "mm" )", "MODDATE4( "changed" )", "MODTIME( "time" )" "CREATED4( "created" )", "CURSIZE( "size" )", "INITSIZE( "init" )" "MODRECS( "mod" )", "USER8( "id" )" if rc > 0 then do zerrlm = lmmstats.rc "SETMSG MSG( ISRZ002 )" sw.0error_found = 1 return end "LMCLOSE DATAID( &BASEID )" if rc > 0 then do zerrlm = lmclose.rc "SETMSG MSG( ISRZ002 )" sw.0error_found = 1 return end "LMFREE DATAID( "baseid" )" if rc > 0 then do zerrlm = lmfree.rc "SETMSG MSG( ISRZ002 )" sw.0error_found = 1 return end if monitor then do say "USER8:" id " VER:" vv " MOD:" mm say "MODDT:" changed " MODTM:" time " CREDT:" created say "CURSZ:" size " INIT:" init " MOD:" mod end /* monitor */ return /*@ B_RESTAT */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO lminit. = "Unknown return code" lminit.8 = "Data set or file not allocated because DDname not", "found or Data set or file organization not supported." lminit.12 = "Invalid parameter value " lminit.16 = "Truncation or translation error in accessing dialog", "variables." lminit.20 = "Severe error " lmopen. = "Unknown return code" lmopen.8 = "Open failed because Data set record format not", "supported by ISPF " lmopen.10 = "No data set associated with the dataid " lmopen.12 = "Invalid parameter value: Data set is already open", "or Cannot open data set allocated 'SHR' for output" lmopen.16 = "Truncation or translation error in storing defined", "variables " lmopen.20 = "Severe error" lmmfind. = "Unknown return code" lmmfind.4 = "Member not available" lmmfind.8 = "Member not found " lmmfind.10 = "No data set or file associated with the given dataid" lmmfind.12 = "Data set or file not open or not open for input", "because Data set is not an ISPF library or MVS", "partitioned data set or Invalid parameter value" lmmfind.16 = "Truncation or translation error in accessing dialog", "variables " lmmfind.20 = "Severe error " lmmstats. = "Unknown return code" lmmstats.4 = "No members match pattern or No member in data set" lmmstats.8 = "Member not found " lmmstats.10 = "No data set associated with the given dataid " lmmstats.12 = "Invalid parameter value: Data set is not open or is", "not partitioned " lmmstats.20 = "Severe error " lmclose. = "Unknown return code" lmclose.8 = "Data set is not open " lmclose.10 = "No data set associated with the given data id " lmclose.20 = "Severe error " lmfree. = "Unknown return code" lmfree.8 = "Free data set or file failed " lmfree.10 = "No data set or file associated with dataid " lmfree.20 = "Severe error " 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" sets ISPF statistics for the dataset and member specified." say " " say " Syntax: "ex_nam" mname (Required)" say " dname (Required)" say " vv (Required)" say " mm (Required)" say " created (ccyy/mm/dd) (Required)" say " changed (ccyy/mm/dd) (Required)" say " time (hh:mm) (Required)" say " size (Required)" say " init (Required)" say " mod (Required)" say " id (Required)" say " " say " mname names the member to be worked. " say " dname identifies the dataset which contains mname " say " vv is the 2-digit version " say " mm is the 2-digit mod-level " say " created is the create-date, CCYY/MM/DD " say " changed is the change-date, CCYY/MM/DD " say " time is the last-modified time, hh:mm " say " size is the number of lines in mname " say " init is the original size of mname " say " mod is the number of modified lines in mname " say " id identifies the last-modified userid " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " 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 " say " 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 */