/* REXX PDSCOPYD copy a member from one PO dataset to another when the DCBs are incompatible for use by IEBCOPY. This also serves as a replacement for IEBCOPY at installations which do not allow its use in the foreground. IEBCOPY is used if called from READY. Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com 19991005 Impact Analysis . SYSEXEC TRAPOUT Modification History 19991118 fxc upgrade from v.19990923 to v.19991109 20010320 fxc include seconds in zlmtime and use 4-digit year 20010509 fxc dsnames could be in quotes... 20210408 fxc upgrade REXXSKEL to v.20210402 20230401 fxc SYSUMON only if not testing 20230524 fxc use IEBCOPY if called from READY 20230726 fxc adjust HELP; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20231201 fxc disable SYSUMON; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; */ arg argline address TSO /* REXXSKEL ver.20210402 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ if sw.0inispf then do "NEWSTACK" /* isolate all queues */ if \sw.0error_found then, call B_ACQUIRE_INPUT /* -*/ if \sw.0error_found then, call C_LOAD_OUTPUT /* -*/ "DELSTACK" /* expose all queues */ end /* in ISPF */ else do /* from READY */ call I_IEBCOPY /* -*/ end /* from READY */ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit(save_rc) /*@ PDSCOPYD */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value "20" with, save_rc . call AA_KEYWDS /* parse keywords and switches*/ dsnimbr = "'"dsni"("memi")'" if monitor then say, "Input:" dsnimbr dsnombr = "'"dsno"("memo")'" if monitor then say, "Output:" dsnombr if Sysdsn(dsnimbr) <> "OK" then, /* input member must exist */ helpmsg = helpmsg, "Specified or implied source member must exist. " if Sysdsn("'"dsno"'") <> "OK" then, /* output dataset must exist */ helpmsg = helpmsg, "Specified or implied target dataset must exist. " if helpmsg <> "" then call HELP /* ...and don't come back -*/ return /*@ A_INIT */ /* Parse keywords and switches . ----------------------------------------------------------------- */ AA_KEYWDS: /*@ */ if branch then call BRANCH address TSO dsni = KEYWD("FROMDS") dsno = KEYWD("TODS") memi = KEYWD("FROMMBR") memo = KEYWD("TOMBR") if dsni""memi = "" then do parse var info source info /* first token may be source */ if Left(source,1) = "'" then do /* source is quoted */ source = Strip(source,,"'") sw.0quotedsrc = 1 end if Pos( "(",source ) > 0 then do /* there is a banana */ parse var source front "(" memi ")" back source = front""back /* reconstruct */ end if sw.0quotedsrc then , dsni = "'"source"'" else , dsni = source end if dsno""memo = "" then do parse var info target info /* next token may be target */ if Left(target,1) = "'" then do /* target is quoted */ target = Strip(target,,"'") sw.0quotedtgt = 1 end if Pos( "(",target ) > 0 then do /* there is a banana */ parse var target front "(" memo ")" back target = front""back /* reconstruct */ end if sw.0quotedtgt then , dsno = "'"target"'" else , dsno = target end parse value memo memi with memo . /* default output to input */ parse value memi memo with memi . /* default output to input */ parse value dsno dsni with dsno . /* default output to input */ parse value dsni dsno with dsni . /* default output to input */ if Words(dsni dsno memi memo) < 3 then, helpmsg = helpmsg, "Invalid parm: too few tokens. " if Left(dsni,1) = "'" then, dsni = Strip(dsni,,"'") /* unquoted */ else, dsni = Userid()"."dsni /* fully-qualified */ if Left(dsno,1) = "'" then, dsno = Strip(dsno,,"'") /* unquoted */ else, dsno = Userid()"."dsno /* fully-qualified */ if dsni""memi = dsno""memo then, helpmsg = helpmsg, "The source cannot be the same as the target. " if helpmsg <> "" then call HELP /* ...and don't come back -*/ return /*@ AA_KEYWDS */ /* Collect stats from input and read the text into the queue. . ----------------------------------------------------------------- */ B_ACQUIRE_INPUT: /*@ */ if branch then call BRANCH address TSO call BA_INPUT_STATS /* -*/ if \sw.0error_found then, call BB_INPUT_DATA /* -*/ return /*@ B_ACQUIRE_INPUT */ /* Get the ISPF statistics (if any) for the input member. . ----------------------------------------------------------------- */ BA_INPUT_STATS: /*@ */ if branch then call BRANCH address ISPEXEC parse value "" with , zlc4date zlm4date zlmtime zlmsec zlcnorc zlinorc, zlmnorc zluser zlvers zlmod . "LMINIT DATAID(BASEID) DATASET('"dsni"')" if rc > 0 then do zerrlm = exec_name "("BRANCH("ID")")", zerrlm address ISPEXEC "SETMSG MSG(ISRZ002)" sw.0error_found = 1; return end "LMOPEN DATAID("baseid")" if rc > 0 then do zerrlm = exec_name "("BRANCH("ID")")", zerrlm address ISPEXEC "SETMSG MSG(ISRZ002)" sw.0error_found = 1 end "LMMFIND DATAID("baseid") MEMBER("memi") STATS(YES)" if rc > 0 & \sw.0error_found then do zerrlm = exec_name "("BRANCH("ID")")", zerrlm address ISPEXEC "SETMSG MSG(ISRZ002)" sw.0error_found = 1 end if zlmsec <> "" then, zlmtime = zlmtime":"zlmsec /* hh:mm:ss */ parse value zlcnorc zlinorc zlmnorc with, zlcnorc zlinorc zlmnorc . /* strip */ "LMCLOSE DATAID("baseid")" "LMFREE DATAID("baseid")" if monitor then say, "Available stats:", zlc4date zlm4date zlmtime zlcnorc zlinorc, zlmnorc zluser zlvers zlmod return /*@ BA_INPUT_STATS */ /* Read the input member into the queue. . ----------------------------------------------------------------- */ BB_INPUT_DATA: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(@DTA) DA("dsnimbr") SHR REU" "EXECIO * DISKR @DTA (FINIS" if monitor then say, queued() "lines read from" dsnimbr return /*@ BB_INPUT_DATA */ /* Write the queue to the target and apply statistics to it. . ----------------------------------------------------------------- */ C_LOAD_OUTPUT: /*@ */ if branch then call BRANCH address TSO call CA_OUTPUT_DATA /* -*/ if \sw.0error_found then, call CB_OUTPUT_STATS /* -*/ "FREE FI(@DTA)" return /*@ C_LOAD_OUTPUT */ /* Write the queued text to the output member. . ----------------------------------------------------------------- */ CA_OUTPUT_DATA: /*@ */ if branch then call BRANCH address TSO if noupdt then do say "Write to" dsnombr "suppressed because of NOUPDT." return end "ALLOC FI(@DTA) DA("dsnombr") SHR REU" "EXECIO" queued() "DISKW @DTA (FINIS" if monitor then say, "Stack written to" dsnombr return /*@ CA_OUTPUT_DATA */ /* Load the ISPF statistics of the input member to the output member. . ----------------------------------------------------------------- */ CB_OUTPUT_STATS: /*@ */ if branch then call BRANCH address ISPEXEC "LMINIT DATAID(BASEID) DATASET('"dsno"')" if monitor then say, "LMMSTATS DATAID("baseid")" "MEMBER("memo")" "USER("zluser")" , "VERSION("zlvers")" "MODLEVEL("zlmod")" , "MODDATE4("zlm4date")" "MODTIME("zlmtime")" , "CREATED4("zlc4date")" "CURSIZE("zlcnorc")" , "INITSIZE("zlinorc")" "MODRECS("zlmnorc")" if noupdt then do say "Stats update of" dsnombr "suppressed because of NOUPDT." end else, "LMMSTATS DATAID("baseid")" "MEMBER("memo")" "USER("zluser")" , "VERSION("zlvers")" "MODLEVEL("zlmod")" , "MODDATE4("zlm4date")" "MODTIME("zlmtime")" , "CREATED4("zlc4date")" "CURSIZE("zlcnorc")" , "INITSIZE("zlinorc")" "MODRECS("zlmnorc")" if rc > 0 then do zerrsm = "Stats Error" zerrlm = "Unable to modify to the ISPF Stats. RC = "rc "SETMSG MSG(ISRZ002)" end /* rc > 0 */ else save_rc = 0 "LMFREE DATAID("baseid")" return /*@ CB_OUTPUT_STATS */ /* Use IEBCOPY when called from READY as ISPF Services will not be available. . ----------------------------------------------------------------- */ I_IEBCOPY: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(SYSUT2) DA( '"dsno"' ) SHR REU" "ALLOC FI(SYSUT1) DA( '"dsni"' ) SHR REU" "ALLOC FI(SYSIN) NEW TRACKS SPACE(1) UNIT(SYSDA)", "LRECL(80) BLKSIZE(800) RECFM(F B) REU" "ALLOC FI(SYSPRINT) DUMMY REUSE" "NEWSTACK" queue " COPY INDD=SYSUT1,OUTDD=SYSUT2" queue " SELECT MEMBER=(("memi","memo",R))" "EXECIO" queued() "DISKW SYSIN (FINIS" "DELSTACK" mstat = Msg("off") "CALL *(IEBCOPY)" "FREE FI(SYSUT1 SYSUT2)" rc = Msg(mstat) return /*@ I_IEBCOPY */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" copy a member from one PO dataset to another. When called" say " from READY, IEBCOPY is used because ISPF services are not " say " available. When called from within an ISPF environment, " say " however, ISPF services perform the copy. This is " say " especially helpful when the DCBs are incompatible and " say " IEBCOPY cannot be used. " say " " say " Syntax: "ex_nam" FROMDS dsni (Required)" say " FROMMBR mbri (Required)" say " TODS dsno " say " TOMBR mbro " say " " say " A minimum of three of these parameters is required, enough to " say " specify or imply both a source and a target. Missing output " say " parameters will default to the input value. The source and " say " target may not be identical. " say " " say " dsni identifies the source dataset (TSO format) " say " " say " mbri identifies the source membername " say " " say " dsno identifies the target dataset (TSO format) " say " " say " mbro identifies the target membername " "NEWSTACK"; pull; "CLEAR"; "DELSTACK" say " " say " Debugging tools provided include: " say " " say " MONITOR displays key information throughout processing. " say " Displays most paragraph names upon entry. " 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 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")" 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 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 */