/* ACQ REXX ACQ for ACQUIRE command Input parameters are: (required:) DDNAME MEMBER (optional:) AS newmember REPLACE INTO alternatedsn Use 'ACQ ?' for HELP-text. ------------------------------------------------------------------- . Process: derive dsnames in ddname verify that dsname1(member) does NOT exist if it does, certify that user wishes to replace find (for 2 to n) first occurrence of dsname(member) setup IEBCOPY allocations to copy from n to 1 invoke IEBCOPY Written by Frank Clarke, rexxhead@yahoo.com around 1992 Impact Analysis . SYSEXEC TRAPOUT Modification History 20210511 fxc REXXSKEL at last 20230407 fxc adjust HELP 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20240414 fxc DUMP_QUEUE quiet ; 20240811 fxc remove NOUPDT from HELP; 20250329 fxc mask 'Process:'; */ arg argline address TSO /* REXXSKEL ver.20210402 */ 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 /* Initialization -*/ call D_GET_DDS /* Parse DD, DSN, and member -*/ call I_IEBCOPY /* Transfer -*/ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ ACQ */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO newmbr = KEYWD("AS") alt_dsn = KEYWD("INTO") repl = SWITCH("REPLACE") parse value "" with, errmsg dsn. parse var info ddname member . /* get input parms */ if member = "" then call HELP if ddname = "" then call HELP return /*@ A_INIT */ /* Find associated datasets and locate the member. . ----------------------------------------------------------------- */ D_GET_DDS: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" "LA" ddname "((STACK" /* get dsnames */ pull dsnames "DELSTACK" if monitor then say, ddname": "dsnames if alt_dsn <> "" then do if Substr(alt_dsn,1,1) <> "'" then, /* unquoted */ alt_dsn = Userid()"."alt_dsn /* add userid. */ else alt_dsn = Strip(alt_dsn,"B","'") /* strip quotes */ if monitor then say, "Adding" alt_dsn dsnames = alt_dsn dsnames if monitor then say, ddname": "dsnames end /* alt_dsn */ dsn.0 = Words(dsnames) /* how many DSNames ? */ exists = "" do i = 1 to dsn.0 /* for each */ dsn.i = Word(dsnames,i) /* load stem */ target = "'"dsn.i"("member")'" /* compose name for Sysdsn */ if sysdsn(target)="OK" then, /* member exists in dsn ? */ exists = exists i /* add index to list */ end /* i */ if exists = "" then do say "No source:" member "does not exist in" ddname exit(4) end if monitor then say, member "exists in" exists if Word(exists,1) = "1" then do /* in target position */ if Words(exists) < 2 then do /* no source */ say "No source:" member "does not exist in a source position." exit(4) end source = Word(exists,2) /* set source */ if repl then nop else do say member "exists in a target position and REPLACE was not", "specified." /* warn the user */ say "Do you wish to over-write the copy in" dsn.1 say " with the copy from" dsn.source "?" "NEWSTACK" pull response /* get answer */ "DELSTACK" if Left(Strip(response),1) = "Y" then nop else exit 8 /* user said 'no' */ end end /* in a target position */ else, source = Word(exists,1) /* first available */ if monitor then say, "Source is" dsn.source return /*@ D_GET_DDS */ /* . ----------------------------------------------------------------- */ I_IEBCOPY: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(SYSUT2) DA('"dsn.1"') SHR REU" "ALLOC FI(SYSUT1) DA('"dsn.source"') 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=(("member","newmbr",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 */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" (acquires) brings a member of a partitioned dataset " say " forward to the first dataset of the concatenation. It " say " does this by invoking IEBCOPY, thus saving the original " say " member statistics. " say " " say " Syntax: "ex_nam" ddname member (Required)" say " AS newmbrnm " say " INTO altdsn " say " REPLACE " say " " say " ddname identifies the DDName to be operated on. " say " " say " member identifies a membername to be acquired, that is, " say " copied to the first dataset in the concatenation " say " from another dataset associated with the file. " say " " say " more... " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " AS newmbrnm causes the target member to be renamed as it is " say " IEBCOPYd. " say " " say " INTO altdsn specifies a dataset other than the first in the " say " concatenation. Quoted if fully-qualified. " say " " say " REPLACE allows replacement of an existing member in the " say " first dataset by a member below it in the " say " concatenation. If REPLACE is not specified and " say " member is discovered in a target position, you " say " will be prompted for permission to over-write " say " it. " say " " say " more... " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution in" say " 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','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.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 */