zOs/REXX.O08/CSMV2
/* rexx */ 00010000
if 1 then
call xmitWsl
if 0 then
call cloneWsl
exit
cloneWsl: procedure expose m.
CALL READdsn 'DSN.ZGL.MAI.DBOF.JCL(LISTNEU)', l.
call readDsn '~Wk.JCL(DBACLONW)', w.
do wx=1 by 1 to 50
if word(w.wx, 2) ^== '=' then
iterate
if word(w.wx, 1) = 'SRCWSLST' then
wSrcX = wx
else if word(w.wx, 1) = 'CLNWSLST' then
wClnX = wx
end
if symbol('wSrcX') ^== 'VAR' then
call err 'srcWsLst' not found
if symbol('wClnX') ^== 'VAR' then
call err 'clnWsLst' not found
iral = dsnAlloc('SYSOUT(T) dd(ir) .WRITER(INTRDR)')
do lx=1 to l.0
w = word(l.lx ,1)
if abbrev(w, '*') then
iterate
if length(w) <> 8 then
call err 'wsl bad length' w
q = left(w, 7)'Q'
w.wSrcX = left(w.wsrcX, pos('=', w.wSrcX)) q','
w.wClnX = left(w.wClnX, pos('=', w.wClnX)) w','
call writeDD 'IR', w.
end
call writeDDend 'IR'
interpret subword(irAl, 2)
return
endProcedure xmitWsl
xmitWsl: procedure expose m.
dst = RZ4
cl = 'DSN.DBA.CLON.WSL'
iffL = 'DSN.DBA.'
iffR = '.IFF'
CALL READdsn 'DSN.ZGL.MAI.DBOF.JCL(LISTCHG)', l.
do lx=1 to l.0
w = word(l.lx ,1)
w = XB03007C
if abbrev(w, '*') then
iterate
if length(w) <> 8 then
call err 'wsl bad length' w
q = left(w, 7)'Q'
i = iffL || q || iffR
c = cl'('q')'
say w cl'('q')' i
if sysDsn("'"c"'") =='OK' then
call csmCopyTx c, dst, c
else
say '***' w c sysDsn("'"c"'")
if sysDsn("'"i"'") =='OK' then
call csmCopyTx i, dst, i
else
say '***' w i sysDsn("'"i"'")
leave
end
return
endProcedure xmitWsl
system = 'RZ2' 00020001
exec= 'A540769.WK.REXX' 00030001
00040001
parse arg fun rest 00050001
say 'csmV2' fun rest 00060001
if fun ^== 'CSMSTARTED' then do 00070001
if 0 then do 00080004
say 'executing copy' 00090004
address Tso "CSMAPPC Start Pgm(CSMEXEC) ", 00100004
"Parm(""Select tsocmd('", 00110004
"%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ')"")" 00120004
say 'copy rc' rc 00130004
end 00140004
say 'executing start csmexec' 00150004
call adrCsm "select tsoCmd('%CSMV2 CSMSTARTED" fun rest"')" 00160004
say 'returned from start csmexec' 00190001
exit 00200001
call adrTso "CSMAPPC Start Pgm(CSMEXEC) ", 00160004
"Parm(""Select Tsocmd('EXEC ''"exec"(CSMV2)'' ''CSMSTARTED" , 00170001
fun rest"''')"")" 00180001
say 'returned from start csmexec' 00190001
exit 00200001
end 00210001
say 'csm started' rest 00220001
if 0 then do 00230004
'%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ' 00240004
say 'rc csrxutil' rc 00250004
"csmexec DSLIST DSNMASK('A540769.WK.**') system(*)" 00260004
end 00270004
if 0 then do 00280004
say 'dslist rc' rc 00290004
say stemsize 00300004
say dsname.1 dsname.10 00310004
say recfm.0 recfm.1 00320004
say lrecl.0 lrecl.1 00330004
end 00340004
if 0 then do 00350004
address tso 'free dd(copyFr copyTo)' 00360004
dsnFr = 'A540769.wk.rexx' 00370004
dsnTo = 'A540769.tmp.aaa' 00380004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00390004
rc = listDsi("copyFr FILE SMSINFO") 00400004
say 'listDsi rc' rc 'for' w sysdsname 00410004
if rc ^= 0 then 00420004
say varExp('sysReason sysMsgLvl1 sysMsgLvl2') 00430004
say varExp('sysLRecL sysBlkSize sysKeyLen') 00440004
say varExp('sysUnit sysTrksCyl sysBlksTrk sysUnits sysUsed') 00450004
say varExp('sysMgmtClass') 00460004
if right(sysDsSms, 7) == 'LIBRARY' | abbrev(sysDsSms, 'PDS') then 00470004
al = 'DSNTYPE(LIBRARY)' 00480004
else 00490004
al = '' 00500004
al = "SYSTEM(RZ2) DDNAME(COPYTo)", 00510004
"DATASET('"dsnTo"') DISP(CAT) DSORG("sysDSorg")", 00520004
"MGMTCLAS("sysMgmtClass")", 00530004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")", 00540004
al "SPACE("sysPrimary"," sysSeconds")" sysUnits 00550004
say al 00560004
address tso "csmexec allocate" al 00570004
say 'alloc rc' rc 00580004
address tso "csmexec COPY inDD(copyFr) outDD(copyTo)" , 00590004
"member(CSMV2)" 00600004
say 'copy rc' rc 00610004
address tso 'free dd(copyFr copyTo)' 00620004
end 00630004
if 0 then do 00640004
call csmCopyTo 'A540769.WK.REXX(CSMV2)', rz2, 'A540769.tmp.aaa(ef)' 00650004
end 00660004
if 1 then do 00640004
call csmCopyTx 'A540769.WK.REXX(CSMV2)', rz8,
, 'A540769.tmp.aaa(CSMV2)'
end 00660004
if 1 then do 00640004
call csmCopyTx 'DSN.DBA.CK01008N.IFF', rz8, 'A540769.tmp.IFFck' 00650004
end 00660004
exit 00670001
00680004
adrCsm: 00690004
return adrTso('csmExec' arg(1), arg(2)) 00700004
endProcedure adrCsm 00710004
00720004
csmCopyTo: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
mbrFr = dsnGetMbr(dsnFr) 00750004
dsnFr = dsnSetMbr(dsnFr) 00760004
mbrTo = dsnGetMbr(dsnTo) 00770004
dsnTo = dsnSetMbr(dsnTo) 00780004
say 'fr' dsnFr mbrFr 'to' sysTo dsnTo mbrTo 00790004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00800004
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"dsnTo"') DISP(OLD)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
say 'could not allocate' al 00840004
say 'trying to create' al 00850004
rc = listDsi("copyFr FILE SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 00900004
if right(sysDsSms, 7) == 'LIBRARY' , 00910004
| abbrev(sysDsSms, 'PDS') then 00920004
al = al 'DSNTYPE(LIBRARY)' 00930004
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 00940004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",00950004
"SPACE("sysPrimary"," sysSeconds")" sysUnits 00960004
say al 00970004
call adrCsm "allocate" al 00980004
end 00990004
cs = "COPY inDD(copyFr) outDD(copyTo)" 01000004
if mbrFr <> '' then 01010004
cs = cs 'MEMBER('mbrFr')' 01020004
if mbrTo <> '' then 01030004
cs = cs 'NEWNAME('mbrTo')' 01040004
call adrCsm cs 01050004
call adrTso 'free dd(copyFr copyTo)', '*' 01060004
return 01070004
endProcedure csmCopyTo 01080004
01090004
csmCopyTx: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
pdsTo = dsnSetMbr(dsnTo) 00780004
if dsnGetMbr(dsnTo) ^= '' ,
& dsnGetMbr(dsnFr) <> dsnGetMbr(dsnTo) then
call err 'member rename' dsnFr 'to' sysTo'/'dsnTo
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"pdsTo"') DISP(SHR)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al 00840004
say 'trying to create' 00850004
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 0090
if right(sysDsSms, 7) == 'LIBRARY' , 0091
| abbrev(sysDsSms, 'PDS') then 0092
al = al 'DSNTYPE(LIBRARY)' 0093
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 0094
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",0095
"SPACE("sysPrimary"," sysSeconds")" sysUnits 0096
say al 0097
call adrCsm "allocate" al 0098
end 0099
call adrTso 'free dd(copyTo)'
call adrTso "exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'",
"'COPY ''"dsnFr"'' TO "sysTo"/''"pdsTo"'' REPLACE'"
return 01070004
endProcedure csmCopyTx 01080004
01090004
varExp: 01100004
parse arg ggVarExpVars 01110004
ggVarExp = '' 01120004
do ggVarExpIx = 1 to words(ggVarExpVars) 01130004
ggVarExp1 = word(ggVarExpVars, ggVarExpIx) 01140004
ggVarExp = ggVarExp ggVarExp1':' value(ggVarExp1) 01150004
end 01160004
return ggVarExp 01170004
/* copy adrTso begin *************************************************/
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
parse arg ggTsoCmd, ggRet
address tso ggTsoCmd
if rc == 0 then return 0
else if ggRet == '*' then return rc
else if wordPos(rc, ggRet) > 0 then return rc
else
call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn ., addPrefix
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
sp = sysvar('SYSPREF')
if sp == '' then
sp = userid()
cx = pos('~', dsn)
if cx < 1 & addPrefix == 1 then
return sp'.'dsn
do while cx ^== 0
le = left(dsn, cx-1)
ri = substr(dsn, cx+1)
if right(le, 1) == '.' | left(ri, 1) == '.' then
dsn = le || sp || ri
else
dsn = le || left('.', le ^== '') || sp ,
|| left('.', ri ^== '') || ri
cx = pos('~', spec, cx)
end
return dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
jcl2dsn: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure
parse arg dsn, mbr
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
return dsn
endProcedure dsnSetMbr
dsnGetMbr: procedure
parse arg dsn
lx = pos('(', dsn)
rx = pos(')', dsn, lx+1)
if lx < 1 then
return ''
else if lx < rx then
return substr(dsn, lx+1, rx-lx-1)
else
return strip(substr(dsn,lx+1))
endProcedure dsnGetMbr
/**********************************************************************
io: read or write a dataset with the following callsequences:
read: readDDBegin, readDD*, readDDEnd
write: writeBegin, writeDD*, writeEnd
readDD returns true if data read, false at eof
***********************************************************************/
/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure
return /* end readDDBegin */
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt = '' then
ggCnt = 100
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
return (value(ggSt'0') > 0)
return /* end readDD */
/*--- finish reading DD ggDD ----------------------------------------*/
readDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure
parse arg ggDD
/* ensure file is erased, if no records are written */
call adrTso 'execio' 0 'diskw' ggDD '(open)'
return /* end writeDDBegin */
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt == '' then
ggCnt = value(ggst'0')
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
return
endSubroutine writeDD
/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskw' ggDD '(finis)'
return /* end writeDDEnd */
/*--- alloc a dsn or a dd -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
ds = ''
m.dsnAlloc.dsn = ds
if left(spec, 1) = '-' then
return strip(substr(spec, 2))
if left(spec, 1) = '&' then /* external spec is handled ok */
spec = strip(substr(spec, 2))
rest = ''
do wx=1 by 1
w = word(spec, wx)
if w = '' then
leave
if abbrev(w, '.') then do
rest = substr(subword(spec, wx), 2)
leave
end
if abbrev(w, ':') then do
nn = substr(subword(spec, wx), 2)
leave
end
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if w = 'CATALOG' then
disp = disp w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if abbrev(w, 'DSN(') then
ds = strip(substr(w, 5, length(w)-5))
else if ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd <> '' & ds = '' & rest = '' & ^ abbrev(disp, 'SYSO') then
return dd
if dd = '' then do
if symbol('m.adrTso.ddNum') = 'VAR' then
dd = m.adrTso.ddNum + 1
else
dd = 1
m.adrTso.ddNum = dd
dd = 'DD' || dd
end
if disp = '' then
disp = 'SHR'
else if pos('(', ds) < 1 then
nop
else if disp = 'MOD' then
call err 'disp mod for' ds
else
disp = 'SHR'
m.dsnAlloc.dsn = ds
if ds <> '' then
ds = "DSN('"ds"')"
alRc = adrTso('alloc dd('dd')' disp ds rest, '*')
if alRc ^== 0 then do
if nn = 'NN' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for alloc dd('dd')' disp ds rest
say 'tsoAlloc rc' alRc 'for alloc dd('dd')' disp ds rest ,
'...trying to create'
call dsnAllocCreate m.dsnAlloc.dsn, nn
call adrTso 'alloc dd('dd')' disp ds rest
end
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
dsnAllocCreate: procedure expose m.
parse arg dsn, atts
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
atts = 'recfm(f b) lrecl('rl')' ,
'block(' (32760 - 32760 // rl)')'
end
else do
if rl = '' then
rl = 32756
atts = 'recfm('substr(atts, 2, 1) 'b) lrecl('rl')' ,
'block(32760)'
end
if pos('(', dsn) > 0 then
atts = atts 'dsntype(library) dsorg(po)' ,
"dsn('"dsnSetMbr(dsn)"')"
else
atts = atts "dsn('"dsn"')"
atts = 'new catalog' atts 'mgmtclas(s005y000) space(10, 1000)'
end
call adrTso 'alloc dd(dsnAlloc)' atts
call adrTso 'free dd(dsnAlloc)'
return
endProcedure dsnAllocCreate
readDSN:
parse arg ggDsnSpec, ggSt
ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN')
call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)'
interpret subword(ggAlloc, 2)
return
endSubroutine readDsn
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
if ggCnt == '' then
ggCnt = value(ggst'0')
ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
'(stem' ggSt 'finis)'
interpret subword(ggAlloc, 2)
if ggSay == 1 | m.debug == 1 then
say ggCnt 'records written to' ggDsnSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
parse arg oo, ha
if pos('I', translate(oo)) > 0 then
call adrIsp 'control errors return'
m.err.opt = translate(oo, 'h', 'H')
if ha == '' then
drop m.err.handler
else
m.err.handler = ha
return
endSubroutine errReset
/*--- error routine: abend with message ------------------------------*/
err:
parse arg ggTxt, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret m.err.handler
call errSay ggTxt
parse source . . ggS3 . /* current rexx */
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if pos('h', ggOpt) > 0 then do
say 'fatal error in' ggS3': divide by zero to show stackHistory'
x = 1 / 0
end
say 'fatal error in' ggS3': exit(12)'
exit errSetRc(12)
endSubroutine err
assert:
interpret 'assertRes =' arg(1)
if ^ assertRes then
call err 'assert failed' arg(1)':' arg(2)
return
endProcedure assert
errSay: procedure expose m.
parse arg msg, st, pref
parse source . . ggS3 . /* current rexx */
if pref == 'e' | (pref == '' & st == '') then
msg = 'fatal error:' msg
else if pref == 'w' then
msgf = 'warning:' msg
else if pref == 0 then
nop
else if right(pref, 1) ^== ' ' then
msg = pref':' msg
else
msg = pref || msg
sx = 0
bx = -1
do lx=1 until bx >= length(msg)
ex = pos('\n', msg, bx+2)
if ex < 1 then
ex = length(msg)+1
if st == '' then do
say substr(msg, bx+2, ex-bx-2)
end
else do
sx = sx+1
m.st.sx = substr(msg, bx+2, ex-bx-2)
m.st.0 = sx
end
bx = ex
end
return
endProcedure errSay
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
say 'fatal error:' msg
call help
call err msg, op
endProcedure errHelp
/*--- set rc for ispf: -------------------------------------------------
if a cmd is run by ispStart, its RC is ignored,
but ISPF passes the value of the shared varible 3IspfRc
back as return code
----------------------------------------------------------------------*/
errSetRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure errSetRc
/*--- output a trace message if m.trace is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
say 'trc:' msg
return
endProcedure trc
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure
parse arg txt, qu
if qu = '' then
qu = '"'
res = qu
ix = 1
do forever
qx = pos(qu, txt, ix)
if qx = 0 then
return res || substr(txt, ix) || qu
res = res || substr(txt, ix, qx-ix) || qu || qu
ix = qx + length(qu)
end
endProcedure quote
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
say 'debug' msg
return
endProcedure debug
/*--- return current time and cpu usage ------------------------------*/
timing: procedure
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say right(' help for rexx' s3, 79, '*')
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
say 'initial commentblock not found for help'
return
end
end
do lx=lx+1 by 1
li = strip(sourceLine(lx), 't', ' ')
if pos('*/', li) > 0 then
leave
say li
end
say right(' end help for rexx' s3, 79, '*')
return 4
endProcedure help
/* copy err end *****************************************************/