zOs/REXX/TKR
/*--- copy tkr begin ---------------------------------------------------
table key relationship
----------------------------------------------------------------------*/
tkrTable: procedure expose m.
parse arg m, key, wh
if m == '' then
m = tkr
dx = pos('.', key)
if dx < 1 then
mt = m'.t.'key
else
mt = key
if m.mt \== 'table' then
if arg() >= 4 then
return arg(4)
else
call err 'not a table' key', mt' mt'->'m.mt
if wh == '' then
return mt
else if wh == 't' then
return m.mt.table
else if wh == 'o' then
return m.mt.order
else if wh == 'f' then
return 'from' m.mt.table 'where' m.mt.cond
else if wh == 'w' then
return m.mt.cond
else if wh == 'e' then
return m.mt.editFun
else
call err 'bad what' wh 'in tkrTable('m',' tb',' wh')'
endProcedure tkrTable
tkrWhere: procedure expose m.
parse arg m, pa ':' wh
if m == '' then
m = tkr
pEx = tkrPath(m, pa)
m.m.path = pEx
sq = wh
do px=words(pEx)-1 by -1 to 1
tt = word(pEx, px)
tf = word(pEx, px+1)
if symbol('m.m.t2t.tt.tf') == 'VAR' then
parse value m.m.t2t.tt.tf 'LEF RIG' with rl fTo fFr
else if symbol('m.m.t2t.tf.tt') == 'VAR' then
parse value m.m.t2t.tf.tt 'RIG LEF' with rl fTo fFr
else
call err 'no relationShip to' tt 'from' tf 'path' pEx,
't.f' m.m.tt.tf 'f.t' m.m.tf.tt
if m.rl.fFr.sql1 \== '' then
sq = m.rl.fFr.sql1 sq')'
else do
kc = min(mGet(m.rl.lef'.'0), mGet(m.rl.rig'.'0))
sq = '('mCatFT(m.rl.fTo, 1, kc, '%qn, %s')')' ,
'in (select' mCatFT(m.rl.fFr, 1, kc, '%qn, %s'),
tkrTable(m,mGet(m.rl.fFr'.'table),'f') sq')'
end
/* kc = min(mGet(m.rl.lef'.'0), mGet(m.rl.rig'.'0))
s2 = '('mCatFT(m.rl.fTo, 1, kc, '%qn, %s')') in'
if m.rl.fFr.special \== '' then
sq = s2 m.rl.fFr.special sq')'
else
sq = s2 '(select' mCatFT(m.rl.fFr, 1, kc, '%qn, %s'),
tkrTable(m,mGet(m.rl.fFr'.'table),'f') sq')'
sq = '('mCatFT(m.rl.fTo, 1, kc, '%qn, %s')')' ,
'in (select' mCatFT(m.rl.fFr, 1, kc, '%qn, %s'),
tkrTable(m,mGet(m.rl.fFr'.'table),'f') sq')' */
end
return sq
endProcedure tkrWhere
tkrPath: procedure expose m.
parse arg m, sPa
res = word(sPa, 1)
do sx=2 to words(sPa)
p1 = tkrPat1(m, word(sPa, sx-1), word(sPa, sx))
if p1 == '' then
call err 'no path to' word(sPa, sx-1) 'from' word(sPa, sx)
res = res subWord(p1, 2)
end
if m.debug then
say '???' sPa '==path==>' res
return res
endProcedure tkrPath
tkrPatChk: procedure expose m.
parse arg m, pa
p2 = space(pa, 1)
do bx=1 to words(m.m.pathBad)
b1 = word(m.m.pathBad, bx)
if abbrev(b1, 1) then do
wx = wordPos(substr(b1, 2), p2)
if wx > 1 & wx < words(p2) then
return ''
end
else if pos('|', b1) > 0 then do
parse var b1 t1 '|' t2
wx = wordPos(t1, p2)
if wx > 1 & wx < words(p2) then
if word(p2, wx-1) \== t2 & word(p2, wx+1) \== t2 then
return ''
end
else if pos('-', b1) > 0 then do
b2 = translate(b1, ' ', '-')
if pos(' 'b2' ', ' 'p2' ') > 0 then
return ''
b3 = ''
do wx=1 to words(b2)
b3 = word(b2, wx) b3
end
if pos(' 'b3' ', ' 'p2' ') > 0 then
return ''
end
else
call err 'bad pathBad word' b1 'in' m.m.pathBad
end
return strip(p2)
endProcedure tkrPatChk
/*--- return path to tt from tf, fail if not unique ------------------*/
tkrPat1: procedure expose m.
parse arg m, tt, tf
m.m.pathRes.0 = 0
call tkrPat3 m, tt, tf
if m.m.pathRes.0 = 1 then
return m.m.pathRes.1
else if m.m.pathRes.0 < 1 then
call err 'no path to' tt 'from' tf
else if m.m.pathRes.0 > 1 then
call err 'multiple ('m.m.pathRes.0') paths to' tt 'from' tf,
mCat(m'.'pathRes, '\n%s%qn\n%s')
endProcedure tkrPat1
/*--- add minimal paths to tt from tf to pathRes ---------------------*/
tkrPat2: procedure expose m.
parse arg m, tt, tf
call tkrPat3 m, tt, tf
if m.debug then do
say '???' tt '<' tf '--pat2-->' m.m.pathRes.0 'paths'
do px=1 to m.m.pathRes.0
say '???'px'???' m.m.pathRes.px
end
end
return
endProcedure tkrPat2
/*--- add minimal paths to tt from tf to pathRes ---------------------*/
tkrPat3: procedure expose m.
parse arg m, tt, pa1 paR
pa = tkrPatChk(m, pa1 paR)
if pa == '' then
return
if tt = pa1 then do
/* ok target reached, is there already a shorter path? */
do px=1 to m.m.pathRes.0
if wordsIsSub(pa, m.m.pathRes.px) then
return
end
/* remove all longer paths */
qx = 0
do px=1 to m.m.pathRes.0
if wordsIsSub(m.m.pathRes.px, pa) then
iterate
qx = qx+1
m.m.pathRes.qx = m.m.pathRes.px
end
/* add new path */
qx = qx+1
m.m.pathRes.qx = pa
m.m.pathRes.0 = qx
return
end
/* use direct connection if it exists */
if symbol('m.m.t2t.tt.pa1') == 'VAR' ,
| symbol('m.m.t2t.pa1.tt') == 'VAR' then do
call tkrPat2 m, tt, tt pa1 paR
return
end
tb1 = tkrTable(m, pa1)
/* try all connections from pa1 */
do rx=1 to words(m.tb1.rels)
r1 = word(m.tb1.rels, rx)
if mGet(mGet(m.r1.lef'.TABLE')'.ALIAS') == pa1 then
a1 = mGet(mGet(m.r1.rig'.TABLE')'.ALIAS')
else if mGet(mGet(m.r1.rig'.TABLE')'.ALIAS') == pa1 then
a1 = mGet(mGet(m.r1.lef'.TABLE')'.ALIAS')
else
call err 'relationship' tb1 'not connecting' pa1
if wordPos(a1, pa1 paR) > 0 then
iterate
call tkrPat2 m, tt, a1 pa1 paR
end
return
endProcedure tkrPat3
wordsIsSub: procedure expose m.
parse arg long, short
sW = words(short)
if sW = 0 then
return 1
lW = words(long)
if sW > lW then
return 0
else if sW = lW then
return space(long, 1) == space(short, 1)
if word(long, lW) \== word(short, sW) then
return 0
lX = 1
do sX=2 to sW-1
lx = wordPos(word(short, sX), long, lX+1)
if lX <= 1 | sW-sX > lW-lX then
return 0
end
return 1
endProcedure wordsIsSub
tkrType: procedure expose m.
parse arg m, col
if m == '' then
m = tkr
upper col
if wordPos(col, m.m.numeric) > 0 then
return 'n'
cNQ = substr(col, 1+pos('.', col))
if wordPos(cNQ, m.m.numeric) > 0 then
return 'n'
if wordPos(cNQ, m.m.hex) > 0 then
return 'x'
return 'c'
endProcedure tkrType
tkrValue: procedure expose m.
parse arg m, al, col, val
if m == '' then
m = tkr
if pos('.', col) < 1 then
if al == '' then
call err 'no alias'
else
col = al'.'col
tt = tkrType(m, col)
if tt == 'c' then
return quote(val, "'")
if tt == 'n' then
if datatype(val, 'n') then
return val
else
call err 'not numeric' val 'for col' col
if tt == 'x' then
if verify(val, '0123456789abcdefABCDEF', 'n') < 1 then
return "x'"val"'"
else
call err 'not a hex value' val 'for col' col
call err 'unsupport tkrType' tt
endProcedure tkrValue
tkrPred: procedure expose m.
parse arg m, al, col, va
if col == '-' | col == '' | va == '*' then
return ''
if m == '' then
m = tkr
if pos('.', col) < 1 then
if al == '' then
call err 'no alias'
else
col = al'.'col
va = tkrValue(m, , col, va)
if abbrev(va, "'") then
if verify(va, '*%_', 'm') > 0 then
return 'and' col 'like' translate(va, '%', '*')
return 'and' col '=' va
endProcedure tkrPred
tkrIniDb2Cat: procedure expose m.
parse arg m
call sqlCatIni
if m == '' then
m = tkr
if m.m.ini == 1 then
return
m.m.ini = 1
y = 'sysIbm.sys'
mC = tkrIniT(m, 'c' y'Columns', 'tbCreator tbName name',
, 'tbCreator tbName colNo', , , '1')
mCo =tkrIniT(m, 'co' y'Copy',
, 'dbName tsName dsNum instance timestamp' ,
, 'co.dbName, co.tsName, co.timestamp desc',
,,'sqlCatCopy')
call tkrIniK m, mCo, '1plus', 'dbName tsName dsNum instance' ,
'timestamp icType start_Rba dsName pit_Rba'
mDb =tkrIniT(m, 'db' y'Database', 'name')
call tkrIniK m, mDb, 'id iu', 'DBID'
mI = tkrIniT(m, 'i' y'Indexes', 'creator name' ,
, 'tbCreator, tbName, creator, name', , , 'vl')
call tkrIniK m, mI, 't i', 'tbCreator tbName'
call tkrIniK m, mI, 'vl u', 'creator name tbCreator tbName'
call tkrIniK m, mI, 'db1 iu', 'dbName indexSpace'
mIK= tkrIniT(m, 'ik' ,
'sysibm.sysIndexes ik' ,
'left join sysibm.sysKeys ikK' ,
'on ikK.ixCreator = ik.creator' ,
'and ikK.ixName=ik.name' ,
'left join sysibm.sysColumns ikC' ,
'on ikC.tbCreator = ik.tbCreator' ,
'and ikC.tbName = ik.tbName' ,
'and ikC.colNo = ikK.colNo' ,
, 'creator name ikK.colSeq' ,
, 'ik.tbCreator, ik.tbName, ik.creator' ,
|| ', ik.name, ikK.colSeq', , 'sqlCatIxKeys','vl')
call tkrIniK m, mIK, 'vl u', 'creator name colName ',
'tbCreator tbName'
call tkrIniT m, 'ip' y'indexPart', 'ixCreator ixName partition' ,
, , , ,1
mPk =tkrIniT(m, 'pk' y'Package', 'location collid name conToken' ,
, 'location, collid, name, pcTimestamp desc',,,'vl')
call tkrIniK m, mPk, '1plus',
, 'location collid name contoken version type'
call tkrIniK m, mPk, 'vl',
, 'location collid name version'
mPkd=tkrIniT(m, 'pkd' y'PackDep',
, 'dLocation dCollid dName dConToken',,,,'vl')
call tkrIniK m, mPkd, 'b', 'bQualifier bName'
call tkrIniK m, mPkd, 'vl', 'dLocation dCollid dName' ,
'bQualifier bName'
mRc =tkrIniT(m, 'rc' 'oa1p.vqz005Recover', 'db ts pa',
,,,'sqlCatRec')
call tkrIniK m, mRc, '1plus', 'db ts pa fun recover',
'basPTT loadText unlTst unl punTst pun tb'
call tkrIniT m, 'ri' y'IndexSpaceStats' ,
, 'creator name partition' ,
, 'creator name instance partition' ,
, , 'sqlCatIxStats', 1
/* 'dbid isobid partition instance' , */
mRT= tkrIniT(m, 'rt' y'TableSpaceStats' ,
, 'dbId psId partition instance',
, 'dbName name instance partition' ,
, , 'sqlCatTSStats')
call tkrIniK m, mRT, '1plus', 'dbId psId partition instance' ,
'dbName name'
call tkrIniK m, mRT, 'nm u', 'dbName name partition instance'
mT = tkrIniT(m, 't' y'Tables', 'creator name',
, , "t.type not in ('A', 'V')", 'sqlCatTables', 1)
call tkrIniK m, mT, 'db i', 'dbName tsName'
call tkrIniK m, mT, '1plus', 'creator name dbName tsName'
mTg =tkrIniT(m, 'tg' y'Triggers', 'schema name seqno',
, 'tbOwner, tbName, schema, name',,, 1)
call tkrIniK m, mTg, 'tb', 'tbOwner tbName'
call tkrIniT m, 'tp' y'TablePart', 'dbName tsName partition'
mTs =tkrIniT(m, 'ts' y'TableSpace', 'dbName name')
call tkrIniK m, mTs, 'id', 'dbId psId'
call tkrIniT m, 'v' y'Tables', 'creator name',, "v.type = 'V'",,1
mVD =tkrIniT(m, 'vd' y'ViewDep', 'dCreator dName',,,,'vl')
call tkrIniK m, mVd, 'b', 'bCreator bName'
call tkrIniK m, mVd, 'vl', 'dCreator dName bCreator bName'
call trkIniR m, 'c', 'v t'
call trkIniR m, 'co', 'ts tp rt.nm rc'
p0sql = '(SelecT smallInt(0) p FroM sysibm.sysDummy1' ,
'union all select smallInt(32767)p FroM sysibm.sysDummy1)p0'
r1 = tkrRel(m, 'co-tp')
m.r1.rig.sql1 = '(co.dbName, co.tsName, co.dsNum)' ,
'in (select tp.dbName, tp.tsName' ,
', min(tp.partition, p0.p)' ,
'from sysibm.sysTablePart tp,' p0Sql 'where'
r2 = tkrRel(m, 'co-rt')
m.r2.rig.sql1 = '(co.dbName, co.tsName, co.dsNum, co.instance)' ,
'in (select rt.dbName, rt.name' ,
', min(rt.partition, p0.p), rt.instance' ,
'from sysibm.sysTablespaceStats rt,' p0Sql 'where'
call trkIniR m, 'db', 'ts t.db tp rc rt co i.db1'
call trkIniR m, 'i.t', 't'
call trkIniR m, 'i', 'ik ip'
call trkIniR m, 'pk', 'pkd'
call trkIniR m, 'pkd.b', 'i', "pkd.bType in ('I')"
call trkIniR m, 'pkd.b', 't v',
, "pkd.bType in ('A', 'G', 'M', 'S', 'T', 'V')"
call trkIniR m, 'pkd.b', 'ts', "pkd.bType in ('P', 'R')"
call trkIniR m, 'rc', 'tp'
call trkIniR m, 'ri', 'i ip'
call trkIniR m, 'rt', 'ts.id'
call trkIniR m, 'rt.nm', 'tp rc'
call trkIniR m, 'tg.tb', 'v t'
call trkIniR m, 'ts', 't.db tp rc'
call trkIniR m, 'vd.b', 't', "vd.bType in ('G', 'M', 'T', 'V')"
call trkIniR m, 'vd', 'v', "vd.dType in ('V', 'M')"
m.m.pathBad = '1c 1co 1db 1tg pkd|pk vd|v pkd-i-t vkd-i-t'
m.m.numeric = 'PARTITION DBID INSTANCE PSID ISOBID DSNUM'
m.m.hex = 'CONTOKEN'
return
endProcedure tkrIniDb2Cat
tkrIniT: procedure expose m.
parse arg m, ty tb, cols, ord, wh, eFun, vl
mt = m'.t.'ty
if symbol('m.mt') == 'VAR' then
call err 'duplicate table' ty tb ord 'old' mt'->'m.mt
m.mt = 'table'
m.mt.alias = ty
m.mt.table = if(words(tb) == 1, tb ty, tb)
m.mt.uKeys = ''
m.mt.oKeys = ''
m.mt.rels = ''
m.mt.pKey = tkrIniK(m, mt, '1 iu', cols)
m.mt.vlKey = ''
if vl \== '' then
m.mt.vlKey = m'.k.'ty'.'vl
if ord == '' then
m.mt.order = mCat(m.mt.pKey, '%qn, %s')
else if pos(',', ord) < 1 & pos('.', ord) < 1 then
m.mt.order = ty'.'repAll(space(ord, 1), ' ', ',' ty'.')
else
m.mt.order = ord
m.mt.cond = wh || copies(' and', wh \== '')
m.mt.editFun = eFun
return mt
endProcedure tkrIniT
tkrIniK: procedure expose m.
parse arg m, tb, nm oo, cols
if pos(':', cols) > 0 | pos(',', cols) > 0 then
call err 'deimplemented iiKey:' cols
mk = m'.k.'m.tb.alias'.'nm
if symbol('m.mk') == 'VAR' then
call err 'duplicate key' tb nm 'old' mk'->'m.mk
m.mk = 'key'
al = m.tb.alias
m.mk.table = tb
m.mk.name = m.tb.alias'.'nm
m.mk.opt = oo
m.mk.0 = words(cols)
do cx=1 to m.mk.0
c1 = word(cols, cx)
dx = pos('.', c1)
if dx < 1 then do
m.mk.cx = al'.'c1
m.mk.cx.col = translate(c1)
end
else do
m.mk.cx = c1
m.mk.cx.col = translate(substr(c1, dx+1))
end
end
m.mk.colList = mCat(mk, '%qn, %s')
if pos('i', oo) > 0 then
m.tb.uKeys = strip(m.tb.uKeys mk)
else
m.tb.oKeys = strip(m.tb.oKeys mk)
return mk
endProcedure tkrIniK
trkIniR: procedure expose m.
parse arg m, le, aRi, leCo, riCo
le = tkrKey(m, le)
lTb = m.le.table
do rx=1 to words(aRi)
ri = tkrKey(m, word(aRi, rx))
rTb = m.ri.table
ky = m'.r.'m.lTb.alias'-'m.rTb.alias
if symbol('m.ky') == 'VAR' then
call err 'duplicate relationShip' ky 'old' m.ky
m.ky = 'relationShip'
m.ky.lef = le
m.ky.lef.sql1 = ''
m.ky.lef.cond = leCo || copies(' and', leCo \== '')
m.lTb.rels = m.lTb.rels ky
m.ky.rig = ri
m.ky.rig.cond = riCo || copies(' and', riCo \== '')
m.ky.rig.sql1 = ''
m.rTb.rels = m.rTb.rels ky
lr = m'.T2T.'m.lTb.alias'.'m.rTb.alias
if symbol('m.lr') == 'VAR' then
call err 'duplicate relationShip' ky 'old' m.lr
rl = m'.T2T.'m.rTb.alias'.'m.lTb.alias
if symbol('m.rl') == 'VAR' then
call err 'duplicate inverse relationShip' ky 'old' m.rl
m.lr = ky
end
return ky
endProcedure trkIniR
tkrKey: procedure expose m.
parse arg m, key
if m == '' then
m = tkr
dx = pos('.', key)
if dx < 1 then do
mt = m'.t.'key
if m.mt == 'table' then
return m.mt.pKey
ee = 'not a table' key':' mt'->'m.mt
end
dx = pos('.', key, dx+1)
if dx < 1 then do
mk = m'.k.'key
if m.mk == 'key' then
return mk
ee = 'not a key' key', mk' mk'->'m.mk
end
if m.key == 'key' then
return key
ee = 'not a key' key'-->'m.key
if arg() >= 3 then
return arg(3)
call err ee
endProcedure tkrKey
tkrRel: procedure expose m.
parse arg m, key
if m == '' then
m = tkr
if m.key == 'relationShip' then
return key
mr = m'.r.'key
if m.mr == 'relationShip' then
return mr
call err 'not a relationship' key'-->'m.key',' m.mr
endProcedure tkrRel
/* copy tkr end ****************************************************/