zOs/REXX.O08/FRANZ
/***********************************************************************
***********************************************************************/
dPref = 'wk.frof'
call readDsn dPref'sr(ddnXXX)', m.new.
call partKey new, n
say m.n.0 'new partitions from' m.new.0 'lines from ddnXXX'
call readDsn dPref'sr(loadjsk)', m.sk.
say m.sk.0 'skeleton lines from loadJsk'
list = '244 241 242 259 260 261'
do listIx=1 to words(list)
tx = word(list, listIx)
call readDsn dPref'sr(ddo'tx')', m.old.
call partKey old, o
say m.o.0 'old partitions from' m.old.0 'lines from ddo'tx
call merge o, n
m.out.0 = 0
call readDsn dPref"sr(PUNCH"tx")", m.pun.
m.lod.1 = 'LOAD DATA LOG NO EBCDIC CCSID(00500,00000,00000)'
do px=1 by 1 to m.pun.0 while left(m.pun.px, 12) ^== ' INTO TABLE '
end
m.lod.2 = strip(left(m.pun.px, 72), 't') 'PART '
if left(m.lod.2, 12) ^== ' INTO TABLE ' then
call err 'into table not found in punch'tx
say 'punch'tx m.lod.2
m.lod.3 = ' RESUME NO REPLACE COPYDDN(TCOPYD) INDDN REC'
do px=px by 1 to m.pun.0 while left(m.pun.px, 6) ^== ' WHEN('
end
if px > m.pun.0 then
call err 'when not found in punch'tx
do lx = 4 by 1 while px <= m.pun.0
m.lod.lx = m.pun.px
if m.pun.px = ' )' then
leave
px = px + 1
end
m.lod.0 = lx
if px > m.pun.0 then
call err ') ending ) not found in punch'tx
/*
do x=1 to m.n.0
call out 'ALTER TABLE xyz.TNZ242A1'
if x <= m.o.0 then
call out ' ALTER PARTITION' x
else
call out ' ADD PARTITION --' x
call out " ENDING AT (X'"m.n.x"');"
end
*/
jobNo = 'j'
tabNo = 't'
jx = 0
do nx=1 by 3 to m.n.0
ny = nx + 2
if ny > m.n.0 then
ny = m.n.0
m.v.tabNo = tx
m.v.jobNo = right(nx, 2, '0')
jx = jx + 1
do sx=1 to m.sk.0
sl = strip(left(m.sk.sx, 72))
if sl == '$r' then do
do nz=nx to ny
li = '//REC'left(nz, 3)
do fx=m.n.nz.beg to m.n.nz.end
ff = format(fx, 5)
call out left(li,14)'DD DISP=SHR,',
|| 'DSN=&OLDPREF.'right(fx,5,0)'&OLDSUF'
li = '//'
end /* each old partition */
end /* each new partition */
end /* $r */
else if sl == '$l' then do
call out m.lod.1
do nz=nx to ny
call out m.lod.2 || nz
call out m.lod.3 || nz
do lx=4 to m.lod.0
call out m.lod.lx
end
end
end
else do
do forever
dx = pos('$', sl)
if dx < 1 then
leave
name = substr(sl, dx+1, 1)
if symbol('m.v.name') ^== 'VAR' then
call err 'undefined symbol $'name ,
'in sk.'sx m.sk.sx
sl = left(sl, dx-1) || m.v.name || substr(sl, dx+2)
end
call out sl
end
end /* each skeleton line */
end /* each job */
say 'generated' jx 'jobs' for 'tnz'tx
call writeDsn dPref'(load'tx')', m.out.
say 'written' m.out.0 'to' dPref'(load'tx')'
end
exit
partKey: procedure expose m.
parse arg i, o
nrLast = 0
do l=1 to m.i.0
line = translate(m.i.l)
pc = wordPos('PART', line)
if pc < 1 then
pc = wordPos('(PART', line)
if pc < 1 then
iterate
nrAct = word(line, pc+1)
val = word(line, pc+2)
if val = 'USING' then
iterate
if nrAct <> nrLast + 1 then
call err 'partition' (nrLast + 1) 'expected not:' line
if left(val, 9) <> "VALUES(X'" then
call err "VALUES(X' expected not:" line
ex = pos("'", val, 10)
if ex < 10 then
call err "ending Apostroph missing" line
m.o.nrAct = substr(val, 10, ex-10)
nrLast = nrAct
end
m.o.0 = nrLast
return
endProcedure partKey
merge: procedure expose m.
parse arg o, n
ox = 1
do nx = 1 to m.n.0
fbeg = ox
do ox=ox by 1 while ox <= m.o.0 & x2c(m.o.ox) < x2c(m.n.nx)
end
if ox > m.o.0 then
ox = m.o.0
fend = ox
m.n.nx.beg = fBeg
m.n.nx.end = fEnd
/* say 'new part' nx left(m.n.nx, 8) ,
'from old' fBeg left(m.o.fBeg, 8) 'to' fEnd left(m.o.fEnd, 8)
li = '//REC'left(nx, 3)
do fx=fBeg to fEnd
ff = format(fx, 5)
call out left(li,14)'DD DISP=SHR,',
|| 'DSN=&OLDPREF.'right(fx,5,0)'&OLDSUF'
li = '//'
end
*/ end
return
endProcedure merge
out: procedure expose m.
parse arg msg
/* say 'out:' strip(msg, 't')
*/ ox = m.out.0 + 1
m.out.0 = ox
m.out.ox = strip(msg, 't')
return
endProcedure out
err:
call errA arg(1), 1
endSubroutine err
/* 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 .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'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
dsn = strip(dsn)
if right(dsn, 1) = "'" then
dsn = strip(left(dsn, length(dsn) - 1))
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
if left(dsn, 1) = "'" then
dsn = dsn"'"
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), 't', "'")
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
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
dsn = ''
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if dsn = '' | left(w, 1) = "'" then
dsn = 'dsn('w')'
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
call adrTso 'alloc dd('dd')' disp dsn subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
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)
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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
/*--- return current time and cpu usage ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- 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 *****************************************************/