/* REXX DUP Copy a PDS or a Sequential file. Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| DUP is designed to work in ISPF 3.4 or from the command-line as a tool that will copy one dataset to another dataset. DUP will present a window to display and collect allocation information used to create the new dataset. Written by Chris Lewis, 1994 Impact Analysis . SYSEXEC TRAPOUT Modification History 19950828 ctl Do not exit if an allocate 19951204 ctl Upgrade REXXSKEL, previous version 950620. Fixed bug with RECFM 19970217 ctl Remove obstacles to allow copy of FBA datasets. 19970313 fxc allow allocation of PS from PO and v.v.; 19970402 fxc fix "blank dballoc" bug 19970605 fxc upgrade from v.951129 to v.970211; halt when todsn pre-exists; reorg code; DECOMM 19981117 fxc upgrade from v.970211 to v.19980225; RXSKLY2K; 19990811 fxc fixed BLOCK bug 19991020 fxc new DEIMBED; upgraded HELP; upgrade REXXSKEL from v.19980225 to v.19991006; 19991206 fxc upgrade from v.19991006 to v.19991109; 20010606 fxc make it understand PDSEs; use PDSCOPYD instead of IEBCOPY; init copy_rc; 20010718 fxc block PFSHOW 20020722 fxc COPY if Sequential 20030711 fxc ensure proper UNIT designation 20230406 fxc adjust HELP text; 20230608 fxc use &ZUP/&ZCONT 20230613 fxc add DEL to DEIMBED ALLOC 20230722 fxc use PDSCOPYD for incompatible DCBs; 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; */ arg argline 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 */ call A_INIT /* -*/ call B_LISTDSI /* -*/ call C_DISPLAY /* -*/ exit /*@ DUP */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call AA_KEYWDS /* -*/ parse value "0" with, copy_rc , . parse value "A" with, sel , warnmsg , . parse var info fromdsn info if fromdsn = "" then, helpmsg = helpmsg "Dataset is Required." else, if Sysdsn(fromdsn) ^= "OK" then helpmsg = helpmsg "Dataset("fromdsn") does not exist." if helpmsg ^= "" then call HELP if sw.0ID then do parse var fromdsn "'" q1 "." remainder todsn = "'"Userid()"."remainder end else todsn = fromdsn return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AA_KEYWDS: /*@ */ if branch then call BRANCH address TSO sw.0ID = SWITCH("ID") return /*@ AA_KEYWDS */ /* . ----------------------------------------------------------------- */ B_LISTDSI: /*@ */ if branch then call BRANCH address TSO rc = listdsi(fromdsn "DIRECTORY") alloc = sysalloc used = sysused mems = sysmembers unit = sysunits dsorg = sysdsorg recfm = sysrecfm lrecl = syslrecl blksize = sysblksize prim = sysprimary secd = sysseconds extents = sysextents dballoc = sysadirblk dbused = sysudirblk created = syscreate if sysadirblk = "NO_LIM" then sw.0library = "1" if sysadirblk = "NO_LIM" then dballoc = "PDSE" if sysdsorg = "PS" then sel = "C" /* Copy */ fromdcb = recfm lrecl zwinttl = exec_name "Facility" return /*@ B_LISTDSI */ /* . ----------------------------------------------------------------- */ C_DISPLAY: /*@ */ if branch then call BRANCH address ISPEXEC call DEIMBED /* deimbed panel "DUP" -*/ @ddn = @ddn.PLIB /* get real DDName */ "LIBDEF ISPPLIB LIBRARY ID("@ddn") STACK" "VGET ZPFCTL"; save_zpf = zpfctl /* save current setting */ do forever zpfctl = "OFF"; "VPUT ZPFCTL" /* PFSHOW OFF */ "ADDPOP ROW(6) COLUMN(6)" "DISPLAY PANEL(DUP)" save_rc = rc "REMPOP ALL" zpfctl = save_zpf; "VPUT ZPFCTL" /* restore */ warnmsg = "" if save_rc > 0 then leave if dballoc = "PDSE" then sw.0library = "1" else sw.0library = "0" rc = CA_ALLOC() /* -*/ if rc ^= 0 | sel = "A" then iterate if dsorg <> alcdsorg then iterate /* can't copy... */ rc = CB_COPY() /* -*/ if rc = 0 then do zerrsm = "Copy Completed" zerrlm = "Copy("rc") from DSN("fromdsn") to DSN("todsn")." "SETMSG MSG(ISRZ002)" end else do zerrsm = "Copy Error" zerrlm = "Copy failed with RC="rc "SETMSG MSG(ISRZ002)" end end /* forever */ "LIBDEF ISPPLIB" return /*@ C_DISPLAY */ /* . ----------------------------------------------------------------- */ CA_ALLOC: /*@ */ if branch then call BRANCH address TSO todcb = recfm lrecl parse var recfm rec 2 fm 3 bk . trec = space(rec fm bk,1) parse value dballoc "0" with dballoc . /* ensure a value */ dsorg. = "" dsorg.PO = "DIR("dballoc")" if dballoc = 0 then alcdsorg = "PS" else alcdsorg = "PO" if Left(unit,1) = "B" then alcunit = "BLOCK("blksize")" else alcunit = unit if sw.0library then, parse value "DSNTYPE(LIBRARY) DSORG(PO)" with dsntype dsorg.po else dsntype = "DSORG("alcdsorg")" alloc.0 = "NEW CATALOG UNIT(SYSDA)" alcunit "SPACE("prim","secd")", "RECFM("trec") LRECL("lrecl") BLKSIZE("blksize")", dsorg.alcdsorg dsntype alloc.1 = "SHR" stat = Sysdsn(todsn) = "OK" if stat then do if todsn = fromdsn then slug = "is the same as the FROM-dataset." else slug = "already exists." zerrsm = "TO dataset ?" zerrlm = "The TO-dataset specified" slug address ISPEXEC "SETMSG MSG(ISRZ002)" return(8) end msgstat = Msg("OFF") "ALLOC FI(SYSUT2) DA("todsn") REUSE" alloc.stat save_rc = rc if rc > 0 then do zerrsm = "ALLOC Error" zerrlm = "Alloc Failed RC("rc") DSN("todsn")" address ISPEXEC "SETMSG MSG(ISRZ002)" end else if sel = "A" then do zerrsm = "Alloc Completed" zerrlm = "Alloc finished RC("rc"). DSN("todsn")" address ISPEXEC "SETMSG MSG(ISRZ002)" end if sel = "A" then "FREE FI(SYSUT2)" rc = Msg(msgstat) return(save_rc) /*@ CA_ALLOC */ /* . ----------------------------------------------------------------- */ CB_COPY: /*@ */ if branch then call BRANCH address TSO if dsorg = "PS" then copy_rc = SEQ_IEBGENER() /* -*/ else, if fromdcb = todcb then copy_rc = PDS_IEBCOPY() /* -*/ else copy_rc = PDS_PDSCOPYD() /* -*/ return(copy_rc) /*@ CB_COPY */ /* . ----------------------------------------------------------------- */ PDS_IEBCOPY: /*@ */ if branch then call BRANCH address tso "ALLOC FI(SYSUT2) DA("todsn") SHR REU" "ALLOC FI(SYSUT1) DA("fromdsn") SHR REU" "ALLOC FI(SYSIN) NEW TRACKS SPACE(1) UNIT(VIO)", "LRECL(80) BLKSIZE(0) RECFM(F B) REU" "ALLOC FI(SYSPRINT) DUMMY REUSE" "NEWSTACK" queue " COPY INDD=SYSUT1,OUTDD=SYSUT2" "EXECIO" queued() "DISKW SYSIN (FINIS" "DELSTACK" mstat = Msg("off") "CALL *(IEBCOPY)" copy_rc = rc "FREE FI(SYSUT1 SYSUT2)" rc = Msg(mstat) return(copy_rc) /*@ PDS_IEBCOPY */ /* Are the DCBs incompatible? IEBCOPY won't work. Use PDSCOPYD. . ----------------------------------------------------------------- */ PDS_PDSCOPYD: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" "MEMBERS" fromdsn pull mbrlist "DELSTACK" do Words( mbrlist ) /* each member */ parse var mbrlist mbr mbrlist "PDSCOPYD FROMDS" fromdsn "FROMMBR" mbr "TODS" todsn end /* mbrlist */ return(copy_rc) /*@ PDS_PDSCOPYD */ /* . ----------------------------------------------------------------- */ SEQ_IEBGENER: /*@ */ if branch then call BRANCH address tso "ALLOC F(SYSUT1) DA("fromdsn") SHR REUSE" "ALLOC F(SYSPRINT) DUMMY REU" "ALLOC FI(SYSIN) DUMMY REU" address LINKMVS "IEBGENER" copy_rc = rc "FREE F(SYSIN SYSPRINT SYSUT1 SYSUT2)" return(copy_rc) /*@ SEQ_IEBGENER */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* 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" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" DUP is designed to work in ISPF 3.4 or from the " say " command-line as a tool that will copy one dataset to " say " another dataset. DUP will present a window to display " say " and collect allocation information used to create the new " say " dataset. " say " " say " Syntax: "ex_nam" from-dsn (Required)" say " ID (Optional)" say " " say " from-dsn identifies the base dataset which is to serve as " say " a model for the DUP operation. The datasetname " say " specified must exist. " say " " say " ID if specified indicates that the caller's TSO UserID " say " is to replace the high-level qualifier on the " say " output dataset. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution " say " 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 "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return say "Total Stacks" rc , /* rc = #of stacks */ "Begin Stacks" tk_init_stacks , /* Stacks present at start */ "Stacks to DUMP" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ say "Processing Stack #" dd "Total Lines:" queued() do queued();pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* . ----------------------------------------------------------------- */ 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+1) /* 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 sourceline(ssii) ; 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 = "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 DUP .. )ATTR DEFAULT(%+_) % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) } TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) # TYPE( OUTPUT ) INTENS( LOW ) CAPS( ON ) JUST( LEFT ) @ TYPE( OUTPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) { TYPE( OUTPUT ) INTENS( HIGH ) COLOR( GREEN ) HILITE( BLINK ) _ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) PAD( '_' ) )BODY WINDOW(62,17) EXPAND(||) %COMMAND ===> }ZCMD + + +From DSN%===>@FROMDSN + +To DSN %===>}TODSN + + +Action %===>}Z+ (Copy or Allocate) {warnmsg +Space: DCB: PDS Only (DB) : + +Alloc %==>#ALLOC+ DSORG %==>#Z + Alloc %==>}Z + +Used %==>#USED + RECFM %==>}Z + Used %==>#Z + +Primary %==>}PRIM + LRECL %==>}LRECL+ Mem %==>#MEMS + +Secondary%==>}SECD + Blk Size%==>}Z + +Extents %==>#Z + +Unit %==>}UNIT + +Created %==>#CREATED + + )INIT .ZVARS = '(SEL DSORG DBALLOC RECFM DBUSED BLKSIZE EXTENTS)' .CURSOR = TODSN .HELP = DUPHELP )REINIT )PROC VER (&SEL,NB,LIST,C,A) VER (&FROMDSN,NB,DSNAME) VER (&TODSN,NB,DSNAME) VER (&DSORG,NB,LIST,PO,PS) VER (&PRIM,NB,NUM) VER (&SECD,NB,NUM) VER (&LRECL,NB,NUM) VER (&UNIT,NB,LIST,TRACK,TRACKS,CYLINDER,BLOCK,BLOCKS) VER (&BLKSIZE,NB,NUM) VER (&RECFM,NB) IF (&DBALLOC = &Z) &DSORG = 'PS' IF (&DBALLOC NE 'PDSE') IF (&DSORG = 'PO') VER (&DBALLOC,NB,NUM) )END ))) PLIB DUPHELP .. )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 |-| &zwinttl |-| TUTORIAL %Next Selection ===>_ZCMD + +This panel allows you to specify whether the output dataset is to be created %("A")+or created-and-filled%("C"),+and it also allows you to alter the +characteristics of the output dataset to be created by DUP. Besides naming +it, you may also change many of the DCB values: number of directory blocks, +RECFM, LRECL, BLKSIZE, Primary/Secondary space, and allocation units. + +If the input dataset is a%PDSE,+"allocated directory blocks" will appear as %"PDSE"+(since a PDSE does not need directory blocks). If you change the +allocated directory blocks to%"PDSE",+the output dataset will be created as a +Library. )PROC &ZUP = DUPHELP &ZCONT = DUPHELP )END */