/* REXX ALLMEM A (hopefully) more efficient ALLMBRS than ALLMBRS. Get and from parms, LMINIT, LMOPEN, LMMLIST OPTION(LIST) LMMLIST OPTION(FREE), LMCLOSE, LMFREE . For each membername returned, EDIT DATASET() MEMBER() MACRO() . The macro to be executed for every member must end with CANCEL, SAVE, or END in order to release the edit for the next member. Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com 20160330 Impact Analysis . SYSEXEC RUNDATA . SYSEXEC TRAPOUT Modification History ccyymmdd xxx ..... .... */ arg argline address TSO /* REXXSKEL ver.20040227 */ 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 /* */ call D_SPIN_MBRS /* */ if \sw.nested then call DUMP_QUEUE /* -*/ exit /*@ ALLMEM */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value "" with, mbrlist . indsn = KEYWD("INDSN") if indsn = "" then do helpmsg = "Must specify a INDSN dataset to be scanned." call HELP /* and don't come back */ end /* no input */ if Left(indsn,1) = "'" then, /* quoted */ indsn = Strip(indsn,,"'") /* unquoted */ else indsn = Userid()"."indsn /* fully-qualified */ macro = KEYWD("MACRO") rundata = KEYPHRS("RUNDATA") return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ D_SPIN_MBRS: /*@ */ if branch then call BRANCH address ISPEXEC call DD_LOAD_RUNDATA /* */ if sw.0error_found then return call DG_GET_MLIST /* */ if \sw.0error_found then, call DM_EDIT_MEMBERS /* */ call DQ_DROP_RUNDATA /* */ parse value "" with, mbr mbrlist return /*@ D_SPIN_MBRS */ /* . ----------------------------------------------------------------- */ DD_LOAD_RUNDATA: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" if rundata <> "" then do "RUNDATA WRITE NOLOG PROGRAM" macro "DATA("rundata")" do queued() /* return from RUNDATA */ pull line if Pos("",line) > 0 then, sw.0Error_Found = 1 say line end /* queued */ end /* rundata */ "DELSTACK" return /*@ DD_LOAD_RUNDATA */ /* . ----------------------------------------------------------------- */ DG_GET_MLIST: /*@ */ if branch then call BRANCH address ISPEXEC "LMINIT DATAID(MLIST) DATASET('"indsn"') ENQ(SHRW)" "LMOPEN DATAID("mlist") OPTION(INPUT)" "LMMLIST DATAID("mlist") OPTION(LIST) MEMBER(MBR)" do while rc = 0 mbrlist = mbrlist mbr "LMMLIST DATAID("mlist") OPTION(LIST) MEMBER(MBR)" end /* rc = 0 */ sav_rc = rc rc = Trace("O"); rc = Trace(tv) if sav_rc = 4 then do say "No members" sw.0Error_found = 1 end /* 4 */ else if sav_rc > 8 then do say "Severe error" sw.0Error_found = 1 end /* > 8 */ "LMMLIST DATAID("mlist") OPTION(FREE)" "LMCLOSE DATAID("mlist")" "LMFREE DATAID("mlist")" return /*@ DG_GET_MLIST */ /* . ----------------------------------------------------------------- */ DM_EDIT_MEMBERS: /*@ */ if branch then call BRANCH address ISPEXEC do Words(mbrlist) parse var mbrlist mbr mbrlist fullds = "'"indsn"("mbr")'" if monitor then say "Editing" fullds "EDIT DATASET("fullds") MACRO("macro")" end /* mbrlist */ return /*@ DM_EDIT_MEMBERS */ /* . ----------------------------------------------------------------- */ DQ_DROP_RUNDATA: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" if rundata <> "" then do "RUNDATA DROP NOLOG PROGRAM" macro end /* rundata */ do queued() /* return from RUNDATA */ pull line say line end /* queued */ "DELSTACK" return /*@ DQ_DROP_RUNDATA */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" ; say "" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" Apply an edit macro onto every member of a partitioned " say " dataset. The macro itself must end via CANCEL, SAVE, or " say " END to avoid having to manually PF3 each one. " say " . RUNDATA may be used to set parms and options for the macro" say " if the macro is capable of using RUNDATA. " say " " say " Syntax: "ex_nam" INDSN indsn (Required)" say " MACRO macro (Required)" say " RUNDATA rundata (Optional)" say " " say " indsn The TSO-format name of the dataset to be edited. " say " " say " macro The macro to be applied to indsn. " say " " say " rundata A RUNDATA DATA() specification. If present, a " say " RUNDATA WRITE will load it for use by macro. " 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 " 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" (( MONITOR TRACE ?R " 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) /* 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 /* form is 'KEY DATA' */ 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 /* form is 'KEY ;: DATA ;:' */ 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")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" 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 ssct . /* 'call ss 122 6' maybe */ if ssct = "" then ssct = 10 if \datatype(ssbeg,"W") | \datatype(ssct,"W") then return ssend = ssbeg + ssct do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw /* form is 'KEY' */ 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.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = 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 */