zOs/REXX.O08/WL
/* rexx ****************************************************************
merge two files
**********************************************************************/
mapDsn = "wk.sql(tsListMR)"
inDsn = "'dsn.dblf.chg.wkl(wkcmpdav)'"
outDsn = "'dsn.dblf.chg.wkl(wkcmpdaw)'"
if 0 then do
x = " und wie geht es dir ? "
say 'orig ' x
say 'r 0 abcdefghi' repWord(x, 0, 'abcdefghi')
say 'r 1 abcdefghi' repWord(x, 1, 'abcdefghi')
say 'r 3 abcdefghi' repWord(x, 3, 'abcdefghi')
say 'r 6 abcdefghi' repWord(x, 6, 'abcdefghi')
say 'r 9 abcdefghi' repWord(x, 9, 'abcdefghi')
exit
end
call readDsn mapDsn, m.mre.
do mx=1 to m.mre.0
tb = strip(substr(m.mre.mx, 3, 12))
ts = strip(substr(m.mre.mx,65,10))'.'strip(substr(m.mre.mx,55,10))
if ts <> '.' then
m.mr.tb = ts
end
call wlReadBegin s, inDsn
do forever
l = wlRead(s, 1)
if l = '' then
leave
w1 = word(m.l, 3)
w2 = word(m.l, 4)
if w2 = 'TABLE' then do
tb = word(m.l, 5)
cx = pos('.', tb)
if cx > 0 then
tNm = substr(tb, cx+1)
else
tNm = tb
ts = ''
if w1 ^= 'CREATE' then
nop /* say w1 w2 m.l */
else do
do forever
l = wlRead(s)
if l = '' then
call err 'no in found'
if word(m.l, 1) = 'IN' then do
ts = word(m.l, 2)
leave
end
end
end
if ts <> '' & symbol("m.mr.tNm") = 'VAR' then do
db = left(ts, pos('.', ts) - 1)
nwTs = m.mr.tNm
nwDb = left(nwTs, pos('.', nwTs) - 1)
if db <> nwDb then
say 'dbChange' db ts '==>' nwDb nwTs
else
m.mt.ts = nwTs
end
end
end
call wlReadEnd s
call wlReadBegin s, inDsn, outDsn
l = wlRead(s, 1)
do while l <> ''
doRead = 1
w1 = word(m.l, 3)
w2 = word(m.l, 4)
if w2 = 'TABLE' then do
tb = word(m.l, 5)
ts = ''
if w1 ^= 'CREATE' then
nop /* say w1 w2 m.l */
else do
do forever
l = wlRead(s)
if l = '' then
call err 'no in found'
if word(m.l, 1) = 'IN' then do
ts = word(m.l, 2)
leave
end
end
end
if symbol("m.mt.ts") = 'VAR' & ts <> m.mt.ts then do
say 'change create table' tb 'ts' ts '==>' m.mt.ts
m.l = strip(repWord(m.l, 2, m.mt.ts), 't')
end
end
else if w2 = 'TABLESPACE' then do
ts = word(m.l, 7)'.'word(m.l, 5)
if w1 ^= 'CREATE' then
say w1 w2 m.l
else if symbol("m.mt.ts") ^= 'VAR' then
say 'keeping new ts' ts symbol("m.mt.ts")
else if ts = m.mt.ts then
nop /* say 'ignoring ts' ts */
else do
nwTs = m.mt.ts
say 'renaming create ts' ts '==>' nwTS
m.l = strip(repWord(m.l, 5,
, substr(nwTs, pos('.', nwTs)+1)), 't')
end
end
if doRead then
l = wlRead(s)
end
call wlReadEnd s
exit
wlReadBegin: procedure expose m.
parse arg m, dsn, cp
dd = 'wlRe'm
call adrTso "alloc dd("dd") shr dsn("dsn")"
call readDDBegin dd
m.m.0 = 0
m.m.blockX = 0
m.m.lineX = 99
m.m.copy = cp <> ''
if m.m.copy then do
call adrTso "alloc dd(wlCp"m") shr dsn("cp")"
call writeDDBegin 'wlCp'm
m.m.cpMark = ''
end
return
endProcedure wlReadBegin
wlRead: procedure expose m.
parse arg m, sql
dd = 'wlRe'm
lx = m.m.lineX
do forEver
if m.m.copy then
if lx > 0 & m.m.cpMark <> '' then
m.m.lx = overlay(m.m.cpMark, m.m.lx, 1)
lx = lx + 1
if lx > m.m.0 then do
m.m.blockX = m.m.blockX + m.m.0
if m.m.copy then
call writeDD 'wlCp'm, 'M.'m'.'
if ^ readDD(dd, 'M.'m'.') then
return ""
lx = 0
end
else do
w1 = word(m.m.lx, 1)
if w1 = '' | left(w1, 1) = '*' then do
end
else if w1 = '-SQL' | sql ^= 1 then do
m.m.lineX = lx
return m'.'lx
end
end
end
endProcedure wlRead
wlReadEnd: procedure expose m.
parse arg m
dd = 'wlRe'm
call readDDEnd dd
call adrTso "free dd("dd")"
if m.m.copy then do
call writeDDEnd 'wlCp'm
call adrTso "free dd(wlCp"m")"
end
return
endProcedure wlReadEnd
say of m.of.0 lf m.lf.0
ox=1
lx=1
mx=0
do while ox <= m.of.0 & lx <= m.lf.0
tof = substr(m.of.ox, 11, 12)
iof = left(m.of.ox, 10)substr(m.of.ox, 31, 20)
tlf = substr(m.lf.lx, 11, 12)
ilf = left(m.lf.lx, 10)substr(m.lf.lx, 31, 20)
if tof << tlf then do
m = 'o' tof || iof
ox = ox + 1
end
else if tof == tlf then do
if substr(iof, 11, 10) == substr(ilf, 11, 10) then
m = '='
else
m = '*'
m = m tlf || iof || ilf
lx = lx + 1
ox = ox + 1
end
else do
m = 'l' tlf || left(' ', 30) || ilf
lx = lx + 1
end
mx = mx + 1
m.mr.mx = m
end
m.mr.0 = mx
call writeDsn "wk.sql(tsListMr)", m.mr.
exit
repWord: procedure
parse arg src, wx, new
if wx < 1 then
return new src
else if wx > words(src) then
return src new
sx = wordIndex(src, wx)
return left(src, sx-1) || new ,
|| substr(src, sx + length(word(src, wx)))
endProcedure repWord
/* copy adrTso begin *************************************************/
/*--- 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 -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
/*--- end write a stem to a dsn -------------------------------------*/
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
/*--- 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 */
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' 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 zIspfRc
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 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/