/* REXX SEIZE While looking at a member in Browse or Edit, pop a panel to collect the targeting information, then invoke PDSCOPYD to seize a copy to the target. . SEIZE is most easily executed via a command-table entry of the form: . SELECT CMD(%SEIZE |&zdsn |&zmem |&zmemb |&zparm . Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke 20010411 rexxhead@yahoo.com Impact Analysis . SYSEXEC FCCMDUPD . SYSEXEC PDSCOPYD . SYSEXEC SYSUMON . SYSEXEC TRAPOUT Modification History 20010718 fxc block PFSHOW 20050518 fxc catch "argline is empty"; 20051121 fxc allow user to demand Edit (WORKIT); 20210925 fxc tgtmem in zerrlm 20230401 fxc SYSUMON only if not testing 20230503 fxc adjust HELP; 20230608 fxc use &ZUP/&ZCONT 20230613 fxc add DEL to DEIMBED ALLOC 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230808 fxc fix non-printable characters in panels; 20240305 fxc align panel names; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; */ arg argline if argline = "" then do /* no command table? */ address TSO parse source . . exec_nm . "CLEAR" say say exec_nm "cannot proceed because there is no data to process." say say "You may not have a command-table entry with the proper" say "configuration, or you may not have loaded your command table." say say "If you have a command table and it has been loaded, you should" say "install" exec_nm "by issuing the following command inside ISPF:" say say " ===> tso" exec_nm "(( install " say say "then immediately reload your command table." say say exec_nm "can only be exercised via a command-table entry. If " say "you do not have a command table, you cannot run this routine. " "NEWSTACK";pull;"DELSTACK" "CLEAR" exit end address ISPEXEC /* REXXSKEL ver.19991109 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ "CONTROL ERRORS RETURN" /* I'll handle my own */ call A_INIT /* -*/ call B_SETUP_LIBDEFS /* -*/ call C_ACQUIRE_TEXT /* -*/ call D_DROP_LIBDEFS /* -*/ if sw.0Redirect then do /* edit new data */ todsn = Strip(todsn,,"'") /* no quotes */ "EDIT DATASET('"olaydsn"')" end if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ SEIZE */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO if tv = 'N' then, /* only if not testing */ "SYSUMON USER" Userid() "TOOL" exec_name parse value " " with, tomem frommbr workit . parse value "0 0 0 0 0 0 0 0" with, disp_rc . call DEIMBED /* -*/ parse var parms "|" dataset . "|" memname "|" memb "|" info parse var dataset node1 "." /* HLQ */ if Length(node1) = 8 & Left(node1,3) = "SYS" then do helpmsg = exec_name "doesn't work for temporary datasets. " call HELP /* -*/ end parse value memname memb with memname . if memname = "" then dsorg = "PS" /* sequential */ else dsorg = "PO" /* partitioned */ if Words(dataset memname) <> 2 then typ = "INPUT" else typ = "OUTPUT" if info = "?" then call HELP /* and don't come back... -*/ if info <> "" then sw.0Redirect = 1 /* go to new data */ newver = KEYWD("TO") /* TO 411, maybe */ return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ B_SETUP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC 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_SETUP_LIBDEFS */ /* . ----------------------------------------------------------------- */ C_ACQUIRE_TEXT: /*@ */ if branch then call BRANCH address ISPEXEC tomem = memname /* seed */ tgtmem = tomem /* for HELP message */ if newver <> "" then do tomem = Reverse(, Overlay(, Reverse(newver),Reverse(tomem), ) , ) tgtmem = tomem /* for HELP message */ end if dsorg = "PS" then fqdsn = dataset else fqdsn = dataset"("memname")" if dataset <> "" then, parse value "'"dataset"'" "Copy" fqdsn with, dataset zwinttl 1 todsn . else, zwinttl = "Copy anything" if newver = "" then call CG_GET_TARGET /* */ if disp_rc > 0 then return if memname = "" then do ldrc = Listdsi(dataset "directory norecall") if sysdsorg = "PS" then frommbr = "" else do zerrsm = "Input member not specified" zerrlm = exec_name "("BRANCH("ID")")", "This process requires an input member if the input", "dataset is PO." "SETMSG MSG(ISRZ002)" sw.0error_found = "1"; return end /* PO and no member */ end /* no input member */ else frommbr = "FROMMBR" memname confirm = "N" /* init */ call CK_VERIFY_TARGET /* -*/ if confirm = "N" then noupdt = "1" /* do not overlay */ if noupdt then do zerrsm = "PDSCOPYD bypassed." zerrlm = "PDSCOPYD bypassed because NOUPDT was specified." address ISPEXEC "SETMSG MSG(ISRZ002)" return end /* noupdt */ call CP_PDSCOPY /* transfer data */ address ISPEXEC "SETMSG MSG(ISRZ002)" return /*@ C_ACQUIRE_TEXT */ /* NEWVER was not specified; prompt. . ----------------------------------------------------------------- */ CG_GET_TARGET: /*@ */ if branch then call BRANCH address ISPEXEC "VGET ZPFCTL"; save_zpf = zpfctl /* save current setting */ zpfctl = "OFF"; "VPUT ZPFCTL" /* PFSHOW OFF */ "ADDPOP ROW(8) COLUMN(5)" "DISPLAY PANEL(FROMTO)" disp_rc = rc "REMPOP ALL" zpfctl = save_zpf; "VPUT ZPFCTL" /* restore */ if workit = "Y" then, sw.0Redirect = 1 return /*@ CG_GET_TARGET */ /* . ----------------------------------------------------------------- */ CK_VERIFY_TARGET: /*@ */ if branch then call BRANCH address ISPEXEC if Left(todsn,1) = "'" then, olaydsn = Strip(todsn,,"'") /* unquoted */ else olaydsn = Userid()"."todsn /* fully-qualified */ /* */ if dsorg = "PS" then nop else olaydsn = olaydsn"("tomem")" if Sysdsn("'"olaydsn"'") = "OK" then, do "VGET ZPFCTL"; save_zpf = zpfctl /* save current setting */ zpfctl = "OFF"; "VPUT ZPFCTL" /* PFSHOW OFF */ "ADDPOP ROW(8) COLUMN(5)" "DISPLAY PANEL(OLCONFRM)" disp_rc = rc "REMPOP ALL" zpfctl = save_zpf; "VPUT ZPFCTL" /* restore */ end else confirm = "Y" /* OK to copy */ return /*@ CK_VERIFY_TARGET */ /* . ----------------------------------------------------------------- */ CP_PDSCOPY: /*@ */ if branch then call BRANCH address TSO if frommbr = "" then tomen = "" else tomem = "TOMBR" tomem "PDSCOPYD FROMDS" dataset frommbr, " TODS" todsn tomem if rc > 0 then do zerrsm = "PDSCOPYD error" zerrlm = "PDSCOPYD did not copy the data" sw.0Redirect = 0 end else do zerrsm = "Copied" zerrlm = memname "in" dataset "was copied to", tgtmem "in" "'"olaydsn"'" end return /*@ CP_PDSCOPY */ /* . ----------------------------------------------------------------- */ D_DROP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC 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 return /*@ D_DROP_LIBDEFS */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO if SWITCH("INSTALL") then do /* set tmpcmds */ queue "SEIZE" /* zctverb */ queue "0" /* zcttrunc */ queue "SELECT CMD(%SEIZE |&ZDSN |&ZMEM |&ZMEMB |&ZPARM )" queue "Copy data" /* zctdesc */ "FCCMDUPD" /* load the table */ exit end /* INSTALL */ 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 DEL UNIT(VIO) SPACE(5 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" 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 Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random(999) @ddn.ddn = @ddn 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 /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" say " " if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" simplifies the copying of the existing dataset. It is " say " designed to be invoked from a command-table entry of the " say " form " say " SELECT CMD(%SEIZE |&zdsn |&zmem |&zmemb |&zparm " say " " say " Syntax: "ex_nam" tag " say " TO mbrsuff " say " (( INSTALL " say " " say " tag is any non-blank string. If any parameter is passed" say " to "exec_name" you will be placed into EDIT on the " say " resultant data. Specifying 'TO' qualifies as a tag." say " " say " mbrsuff specifies a 'tail' for the current member. If " say " mbrsuff is specified, it will be overlayed on the " say " rightmost positions of the current membername and " say " you will be placed into EDIT on that new member " say " after it has been created. " say " " say " If mbrsuff is not specified, you will be prompted " say " with a pop-up panel to specify a new membername. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " INSTALL causes a command of the appropriate form to be " say " inserted to the user's personal command table. " say " " say " When INSTALL has been requested no other processing " say " takes place regardless of any parameters passed. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " 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 */ 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 . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" 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 FROMTO .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) PAD( '_' ) @ TYPE( &TYP ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) } TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) )BODY WINDOW(62,7) +From DSN%==>@DATASET + + Mem%==>@MEMNAME + + +To DSN%==>}TODSN + + Mem%==>}TOMEM + + + Edit ?%==>}z+ (Y or N) )INIT .HELP = FROMTOH .ZVARS = '(WORKIT)' .CURSOR = TODSN )PROC VER (&TODSN,NB,DSNAME) IF (&DSORG = 'PS') VER (&TOMEM,NAME) ELSE VER (&TOMEM,NB,NAME) )END ))) PLIB FROMTOH .. )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(||) %TUTORIAL |-| SEIZE - Specify Target |-| TUTORIAL %Next Selection ===>_ZCMD + The FROMDSN and FROMMBR have been determined by your current location. Please specify the target dataset and member. If you want to be placed into EDIT on the new text, indicate "Y" for "Edit ?". )PROC &ZUP = FROMTOH &ZCONT = FROMTOH )END ))) PLIB OLCONFRM .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) PAD( '_' ) @ TYPE( OUTPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) )BODY WINDOW(45,10) + + +Mem ==>@TOMEM + +Dsn ==>@OLAYDSN + + +Member already exists in Dataset + +Overlay? ==> _Z+ (Yes/No) + + )INIT .ZVARS = '(CONFIRM)' .CURSOR = CONFIRM &CONFIRM = 'N' )PROC VER (&CONFIRM,NB,LIST,Y,N) )END ))) PLIB INSTALL .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) PAD( '_' ) @ TYPE( OUTPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) } TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) )BODY WINDOW(68,5) + + ISPTLIB DSN%==>}tlibds + + ...CMDS%==>}z + + )INIT .ZVARS = '(CMDTBL)' .HELP = INSTALH .CURSOR = TLIBDS )PROC VER (&TLIBDS,DSNAME) VER (&CMDTBL,NAME) VPUT (CMDTBL,TLIBDS) PROFILE )END ))) PLIB INSTALH .. )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(||) %TUTORIAL |-| COMPILE -- Install Shortcut |-| TUTORIAL %Next Selection ===>_ZCMD + Enter a Library datasetname and membername to identify your personal command table. A shortcut will be generated at that location. If you do not have a personal command table, leave this information blank and the installation step will be skipped. It is%HIGHLY RECOMMENDED+that you have a personal command table which can be activated as by (e.g.) ADDCMDS. )PROC &ZUP = INSTALH &ZCONT = INSTALH )END */