zOs/REXX.O08/DBARB
/* rexx ****************************************************************
synopsis: DBARB [subsys]
version vom 19.10.2006
edit macro to generate rebinds for a worklist
function:
search sql DDL statements in currently edited data
find packages dependent on created/dropped/altered
tablespaces, tables, views, indexes, aliases or synonyms,
append rebind statements for these packages and
remove existing rebinds at the end of the data
subsys may be one of the following
? for this help
empty for deduce subsys from WSLLib, qualifiers or sysnode
x for DBxF
yy for DByy
zzzz for zzzz
************************************************************************
14.12.2006 scan start robuster gemacht gegen ScanErr
***********************************************************************/
/*
20.10.2006 synonym und tablespace eingebaut
19.10.2006 viewDep muss nicht berücksichtigt werden, weil DB2
mit einem Objekt auch alle abhängigen Views löscht
***********************************************************************/
parse arg args
m.debug = 0 /* debug output */
m.cmp = userid() = 'A540769' /* compare old and new rebinds */
call adrIsp 'control errors return'
isMacro = 0
if word(args, 1) == 'isMacro' then do
isMacro = 1
args = subword(args, 2)
end
else if args = '' then do
if adrEdit('macro (args)', 20) == 0 then
isMacro = 1
end
if ^ isMacro then
call errHelp 'not started as editMacro'
if pos('?', args) > 0 then
exit help()
m.types = 'R T V X A S'
m.typNames = 'tablespace table view index alias synonym'
m.cmp.0 = 0
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
m.obj.typ.0 = 0
end
/* analyze ddl in data
and extract changed db2 objects */
call scanStart mr
call scanOptions mr, ,'_0123456789', '--'
call ooDefREad mr, 'res = readMacro('oid', var);'
if isMacro then
call searchObjects
li = '' /* format and display counts */
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
li = li',' m.obj.typ.0 word(m.typNames, tyx)
end
li = substr(li, 3)
say 'found' li
/* find db2 subsystem */
m.subsys = dbSubSys(translate(args))
/* show db2 objects in data */
call adrEdit '(origZl) = lineNum .zl'
call appLine '-- generating rebinds in' m.subsys ,
'at' time('n') date('e') 'for' userid()
call appLine '-- for' li
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
tNa = left(word(m.typNames, tyx), 10)
do x=1 to m.obj.typ.0
call appLine '-- ' tNa m.obj.typ.x
end
end
/* search dependent packages in db2 catalog */
sql = genSql()
if sql ^== '' then do
sp = left('-- rebind old state', 72-39-2)
say 'connecting to' m.subsys
call adrSqlConnect m.subsys
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
cnt = 0
/* fetch each package and write rebind */
do forever
call adrSql 'fetch c1 into :coll, :name, :vers, :type, :info'
if sqlCode = 100 then
leave
cnt = cnt + 1
coll = strip(coll)
name = strip(name)
vers = strip(vers)
if type == 'T' then
call appLine 'REBIND TRIGGER PACKAGE('coll'.'name');'
else
call appLine 'REBIND PACKAGE('coll'.'name'.('vers'));'
call appLine ' --' info
end
call adrSql 'close c1'
say 'found' cnt 'packages'
end
call deleteRebindsUntil origZl
if m.cmp then
call cmpPrint
call adrSqlDisconnect
exit
/--- search db2 objects changed in the ddl ---------------------------*/
searchObjects: procedure expose m.
sqls = 'create alter drop'
do sx =1 to words(sqls) /* for each sql command */
s1 = word(sqls, sx)
call adrEdit "cursor = .zf"
do while adrEdit("seek" s1 'word', 4) = 0 /* find each command*/
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
if ^ scanAtCursor(s1) then
iterate
typ = sqlName()
if wordpos(typ, 'UNIQUE LARGE LOB') > 0 then
typ = sqlName()
if typ = '' then
call scanErr mr, 'object type expected'
if wordPos(typ, translate(m.typNames)) <= 0 then
iterate
tyCh = word(m.types, wordPos(typ, translate(m.typNames)))
if s1 ^= 'create' then do
nm = sqlQualId()
end
else if typ = 'INDEX' then do
nm = sqlQualId()
if sqlName() ^== 'ON' then
call scanErr mr, 'ON expected after create index' nm
call addObj t, sqlQualId()
end
else if typ = 'TABLESPACE' then do
nm = sqlIdent()
if sqlName() ^== 'IN' then
call scanErr mr,
, 'IN expected after create tablespace' nm
nm = sqlIdent()'.'nm
end
else if typ = 'SYNONYM' then do
nm = sqlIdent()
if sqlName() ^== 'FOR' then
call scanErr mr,
, 'FOR expected after create synonym' nm
nm = sqlIdent()'.'nm
end
else do
nm = sqlQualId()
end
call addObj tyCh, nm
end /* each command found */
end /* each sql command */
return
endProcedure searchObjects
/*--- add a db2 object nm of type typ to the list,
if not done already -----------------------------------*/
addObj: procedure expose m.
parse arg typ, nm
if symbol('m.obj.typ.nm') ^= 'VAR' then do
nx = m.obj.typ.0 + 1
m.obj.typ.0 = nx
m.obj.typ.nx = nm
m.obj.typ.nm = nx
end
return
endProcedure addObj
/*--- return the sql to retrieve the packages
dependent on db2 objects in out list ----------------------*/
genSql: procedure expose m.
m.obj.ow.0 = 0
cntTav = 0
cntIdx = 0
/* build lists of names by qualifier */
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
do ox=1 to m.obj.typ.0
qu = anaQualIdent(m.obj.typ.ox)
cntTav = cntTav + 1
if symbol('m.obj.ow.qu') ^== 'VAR' then do
call addObj ow, qu
m.tav.qu = m.ident
m.idx.qu = ''
end
else do
m.tav.qu = m.tav.qu"," m.ident
end
if typ == 'X' then do
/* additional list for indexes */
cntIdx = cntIdx + 1
if m.idx.qu = '' then
m.idx.qu = m.ident
else
m.idx.qu = m.idx.qu"," m.ident
end
end
end
if cntTav = 0 & cntIdx = 0 then
return ''
do y=1 to m.debug * m.obj.ow.0 /* debug lists */
qu = m.obj.ow.y
say y 'qual' qu 'tav:' m.tav.qu 'index:' m.idx.qu
end
/* build sql */
sql = 'select distinct p.collid, p.Name, p.version, p.type,' ,
"'vivo=' || p.validate || p.isolation ||" ,
"p.valid || p.operative ||" ,
"' con=' || hex(p.contoken) ||" ,
"' tst=' || char(p.timestamp)" ,
'from sysibm.syspackdep d join sysibm.syspackage p' ,
'on p.location = d.dLocation and p.collid = d.dCollid' ,
'and p.name = d.dName and p.conToken = d.dConToken' ,
'where'
do y=1 to m.obj.ow.0 /* add each qualifier */
qu = m.obj.ow.y
if m.tav.qu ^= '' then
sql=sql '( bQualifier =' qu 'and bName in ('m.tav.qu')) or'
end
if cntIdx <= 0 then do
sql = left(sql, length(sql) - 3)
end
else do /* subselect for tables of indexes */
sql=sql '( (bQualifier, bName) in' ,
'( select tbcreator, tbname' ,
'from sysibm.sysindexes where'
do y=1 to m.obj.ow.0
qu = m.obj.ow.y
if m.idx.qu ^= '' then
sql=sql '( creator =' qu 'and name in ('m.idx.qu')) or'
end
sql = left(sql, length(sql) - 3) ') )'
end
if m.debug then do /* debug generated sql */
l = 60
c = 1
do while length(sql) - c > l
do e = c+l by -1 while substr(sql, e, 1) ^== ' '
end
say substr(sql, c, e - c)
c = e + 1
end
say substr(sql, c)
end
return sql
endProcedure genSql
/*--- analyze the two parts of a qualified sql identifier ------------*/
anaQualIdent: procedure expose m.
parse arg s
if left(s, 1) = '"' then do
dx = pos('"', s, 2)
m.qual = substr(s, 2, dx - 2)
dx = dx + 1
end
else do
dx = pos('.', s)
m.qual = left(s, dx - 1)
end
if substr(s, dx+1, 1) = '"' then do
ex = pos('"', s, dx+2)
m.ident = substr(s, dx+2, ex - dx - 2)
end
else do
m.ident = substr(s, dx+ 1)
end
m.qual = "'"m.qual"'"
m.ident = "'"m.ident"'"
return m.qual
endProcedure anaQualIdent
/*--- detect the db2 subsystem ---------------------------------------*/
dbSubSys: procedure expose m.
parse arg a
/* subsys may be passed as argument */
if length(a) = 4 then
return a
else if length(a) = 2 then
return 'DB'a
else if length(a) = 1 then
return 'DB'a'F'
else if length(a) ^= 0 then
call errHelp 'bad abbreviation for db2 subsystem: "'a'"'
/* the db admin tool puts the name of the curren WSL library
in the variable ADBWLDSN in the shared pool,
however the session might be in a different split screen */
wslSubSys= ''
if ADRISP('VGET ADBWLDSN', '*') = 0 then do
if left(adbwldsn, 9) == "'DSN.DBA." ,
& substr(adbwldsn, 14) == ".WSL'" then
wslSubSys = substr(adbwldsn, 10, 4)
/* say 'db2SubSys' wslSubSys 'deduced from WSLLib' adbwldsn */
end
/* can we deduce the db2SubSys from the qualifiers? */
quaSubSys = ''
aa = ''
q = ''
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
do x=1 to m.obj.typ.0
id = anaQualIdent(m.obj.typ.x)
upper m.qual
if pos(m.qual, aa) > 0 then
iterate
aa = aa m.qual
if substr(m.qual, 2, 3) = 'OA1' then
n = substr(m.qual, 5, 1)
else if substr(m.qual, 2, 3) = 'GDB' then
n = 'A'
else
iterate
/* compare new char with previous */
if q == '' then
q = n
else if q ^== n then
q = '*'
end
end
nd = sysvar(sysnode)
if length(q) = 1 & pos(q, 'ATZLP') > 0 then do
quaSubSys = 'DB'translate(q, 'O', 'P')'F'
if nd = 'RZ8' & quaSubSys = 'DBOF' then
quaSubSys = 'DM0G'
/* say 'db2SubSys' quaSubSys 'deduced from qualifiers:' aa */
end
/* compare what we got */
if wslSubSys <> '' then
if wslSubSys == quaSubSys | quaSubSys == '' then
return wslSubSys
else
call errHelp 'specify subsys because' wslSubSys,
'from WSLLib mismatches' quaSubsys 'from qualifiers ('aa')'
else if quaSubSys <> '' then
return quaSubSys
if nd = 'RZ2' | nd = 'RR2' then
return 'DBOF' /* here we have only one subsys | */
else if nd = 'RZ8' then
return 'DM0G' /* here we have only one subsys | */
else
call errHelp 'specify subsys.' ,
'Neither WSLLib nor qualifiers ('aa') do'
endProcecdure dbSubSys
/*--- delete comments and rebind statements
backward from given line and position cursor --------------*/
deleteRebindsUntil: procedure expose m.
parse arg origZl
/* scan backward over old rebind statements */
do lx = origZl by -1 to 1
call adrEdit '(li) = line' lx
w = word(li, 1)
if w = '' | left(w, 2) = '--' then
nop
else if translate(left(w, 6)) = 'REBIND' then
call cmp 'o', li
else
leave
end
/* scan forward over comments without rebind */
do lx = lx+1 by 1 to origZl
call adrEdit '(li) = line' lx
if li = '' | (left(word(li, 1), 2) = '--' ,
& pos('REBIND', translate(li)) < 1) then nop
else
leave
end
if lx < origZl then
call adrEdit 'delete' lx origZl
/* position cursor */
if lx < 10 then
lx = 2
call adrEdit 'locate' (lx-1)
return
endProcedure deleteRebinds
/*--- append 1 line at the end of the data ---------------------------*/
appLine: procedure expose m.
parse arg line
call adrEdit 'line_after .zl = (line)'
if word(line, 1) = 'REBIND' then
call cmp 'n' , line
return
endProcedure appLine
/*--- compare rebind statements --------------------------------------*/
cmp: procedure expose m.
parse arg typ, line
line = strip(line)
do x=1 to m.cmp.0
if m.cmp.x = line then do
m.cmpTyp.x = m.cmpTyp.x || typ
return
end
end
m.cmp.0 = x
m.cmp.x = line
m.cmpTyp.x = typ
return
endProcedure cmp
/*--- print compare rebind statements --------------------------------*/
cmpPrint: procedure expose m.
parse arg typ, line
eq = 0
nw = 0
od = 0
un = 0
do x=1 to m.cmp.0
if m.cmpTyp.x = 'no' | m.cmpTyp.x = 'on' then do
m.cmpTyp.x = '='
eq = eq + 1
end
else if m.cmpTyp.x = 'n' then
nw = nw + 1
else if m.cmpTyp.x = 'o' then
od = od + 1
else
un = un + 1
end
call appLine '---- compare' eq '=,' nw 'new,' od 'old,' ,
un 'others, total' m.cmp.0
do x=1 to m.cmp.0
call appLine '--'left(m.cmpTyp.x, 5)m.cmp.x
end
return
endProcedure cmpPrint
/***********************************************************************
scanning sql
***********************************************************************/
/*--- scan a qualified sql identifier --------------------------------*/
sqlQualId: procedure expose m.
q1 = sqlIdent()
if q1 = '' then
call scanErr mr, 'sql qualifier expected'
call scanSpaceNl mr
if ^ scanLit(mr, '.') then
call scanErr mr,
, '. between sql qualifier' q1 'and identifer expected'
q2 = sqlIdent()
if q2 == '' then
call scanErr mr, 'sql identifier after . expected'
return q1'.'q2
endProcedure sqlQualId
/*--- scan a sql identifier e.g. abc or "efg" ------------------------*/
sqlIdent: procedure expose m.
nm = sqlName()
if nm ^== '' then
return nm
if scanString(mr, '"') then
return m.tok
else
return ''
endProcedure sqlIdent
/*--- scan a name after skipping over space and newLines -------------*/
sqlName: procedure expose m.
call scanSpaceNl mr
if ^ scanName(mr) then
return ''
return translate(m.tok)
endProcedure sqlName
/***********************************************************************
interface to scan - use edit data as scanner input
***********************************************************************/
/*--- start reading at cursor after token wrd ------------------------*/
scanAtCursor: procedure expose m.
parse upper arg wrd
call adrEdit "(lx, cx) = cursor"
call scanMacro mr, lx
if cx > 1 then do
x = scanChar(mr, cx-2)
if ^ (scanLit(mr, ' ') | scanLit(mr, ';')) then
return 0
end
nm = sqlName()
return nm == wrd
endProcedure scanAtCursor
/*--- start reading from edit line lx --------------------------------*/
scanMacro: procedure expose m.
parse arg m, lx
m.m.readMacroLx = lx - 1
call scanReader mr, mr
return
endProcedure scanMacor
/*--- read next line from edit data ----------------------------------*/
readMacro: procedure expose m.
parse arg m, var
m.m.readMacroLx = m.m.readMacroLx + 1
if adrEdit('(ll) = line' m.m.readMacroLx, 12) ^= 0 then
return 0
m.var = ll
return 1
endProcedure scanMacro
/*--- error handling -------------------------------------------------*/
err:
call errA arg(1), 1
endSubroutine err
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanReader: procedure expose m.
parse arg m, inRdr
call scanStart m, inRdr
m.scan.m.src = ''
m.scan.m.atEnd = ^ scanNL(m, 1)
return m
endProcedure scanReader
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 0
else if ^ ooRead(m.scan.m.reader, 'SCAN.'m'.SRC') then do
m.scan.m.atEnd = 1
return 0
end
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m, m.scan.m.reader
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then
m.scan.m.Name1 = nameOne
if nameOne ^= '' | namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 1
else
return m.scan.m.atEnd
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, ix, length(tok) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then leave
else if ^ scanLit(m, cc) then leave
else if ^scanNL(m, 1) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
/* copy oo begin ******************************************************/
call ooIni
/* ri = readDsnOpen(ooNew(), 'wk.text(testin)') */
call ooArgs2Stem aaa, 1, 'aaa.1 eins', 'aaa.2 zwei', 'aaa.3 drei'
ri = readCatOpen(ooNew(), "&AAA $ wk.text(testin) ",,'&' aaa,
, 'wk.text(msk1) $ &AAA')
do i=1 by 1 while ooRead(ri, line)
say 'line' i strip(m.line, 't')
end
call ooReadClose ri
exit
ooIni: procedure expose m.
m.oo.lastId = 1
return
endProcedure ooIni
ooNew: procedure expose m.
m.oo.lastId = m.oo.lastId + 1
return m.oo.lastId
endProcedure newoo
ooFree: procedure expose m.
parse arg id
return
endProcedure ooFree
ooRead: procedure expose m.
parse arg oid, var
res = '?'
interpret m.oo.oid.read
return res
endProcedure ooRead
ooReadClose: procedure expose m.
parse arg oid
stem = ''
interpret m.oo.oid.readClose
m.oo.oid.read = 'res=0'
m.oo.oid.readClose = ''
return
endProcedure ooReadClose
ooDefRead: procedure expose m.
parse arg oid, m.oo.oid.read, m.oo.oid.readClose
return oid
endProcedure ooDefRead
ooDefReadStem: procedure expose m.
parse arg oid, m.oo.oid.readStem, close
m.oo.oid.0 = 0
m.oo.oid.readStemCx = 0
return ooDefRead(oid, 'res = ooReadStem2Ln("'oid'", var);', close)
endProcedure ooDefReadStem
ooReadStem2Ln: procedure expose m.
parse arg oid, v
cx = m.oo.oid.readStemCx
if cx >= m.oo.oid.0 then do
res = '?'
stem = 'OO.'oid
m.stem.0 = 0
m.oo.oid.stCx = 0
interpret m.oo.oid.readStem
if ^ res then
return 0
else if m.stem.0 < 1 then
call err 'stem.0='m.stem.0 'after 1 from' m.oo.oid.readStem
cx = 0
end
cx = cx + 1
m.v = m.oo.oid.cx
m.oo.oid.readStemCx = cx
return 1
endProcedure ooReadStem2Ln
ooReadStemOpen: procedure expose m.
parse arg oid, stem
call ooDefReadStem oid, 'res = 0;'
do ix=0 by 1 to m.stem.0
m.oo.oid.ix = m.stem.ix
end
m.oo.oid.0 = m.stem.0
return oid
endProcedure ooReadStemOpen
ooReadArgsOpen: procedure expose m.
parse arg oid, ox
call ooDefReadStem oid, 'res = 0;'
if ox = '' then
ox = m.oo.oid.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.oo.oud.ox = arg(ax)
end
m.oo.oid.0 = ox
return oid
endProcedure ooReadArgsOpen
ooArgs2Stem: procedure expose m.
parse arg stem, ox
if ox = '' then
ox = m.stem.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.stem.ox = arg(ax)
end
m.stem.0 = ox
return stem
endProcedure ooArgs2Stem
/* copy oo end ********************************************************/
/* copy adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql end *************************************************/
/* copy adrIsp begin *************************************************/
/**********************************************************************
lmd: catalog read
call sequence: lmdBegin, lmdNext*, lmdEnd
mit lmd service (mit save in file und read,
weil list zu langsam und listcat abstürzt)
1. arg (grp) als group dataset für lmd save
und dd name für file read
***********************************************************************/
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
res = adrIsp('lmdlist listid(&lmdId) option(save) group('grp')', 4)
call adrIsp 'lmdfree listid(&lmdId)'
if res = 0 then do
call trc showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt, withVolume
if ^ readDD(ggGrp, ggSt) then
return 0
if withVolume ^== 1 then
do ggIx=1 to value(ggSt'0')
x = value(ggSt || ggIx, word(value(ggSt || ggIx), 1))
end
return 1
endSubroutin lmdNext
lmdEnd: procedure
parse arg grp
call readDDEnd grp
call adrTso 'free dd('grp')'
return /* end lmdEnd */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsn
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
res = lmmId
if mbr <> '' then
res = res 'pattern('mbr')'
return res
endProcedure lmmBegin
lmmEnd: procedure
parse arg lmmId opt
call adrIsp "LMMLIST DATAID("lmmId") option(free)", 8
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
if adrIsp("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
return mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: procedure
parse arg dsn, mbrs
mbrs = dsnGetMbr(dsn) mbrs
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(OUTPUT) "
err = ''
do wx=1 to words(mbrs)
m1 = word(mbrs, wx)
rr = adrIsp("lmmDel dataid("lmmId") member("m1")", 0 8 12)
if rc = 0 then
say 'removed' m1 'from' pds
else if rc = 8 then
say 'not found' m1 'in' pds
else do
err = 'error deleting' m1 'in' pds 'rc' rr strip(zerrlm)
say err
leave
end
end
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
if err <> '' then
call err err
return
/**********************************************************************
adr*: address an environment
***********************************************************************/
adrIsp:
parse arg ggIspCmd, ggRet
address ispexec ggIspCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr ispExec rc' rc 'in' ggIspCmd':' strip(zerrlm)
endSubroutine adrIsp
adrEdit:
parse arg ggEditCmd, ggRet
address isrEdit ggEditCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr isrEdit rc' rc 'for' ggEditCmd
endSubroutine adrEdit
/* copy adrIsp end *************************************************/
/* 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 *****************************************************/
COMMIT;
CREATE unique index vdps2.iixdu on VDPS2.DTUNDERFIXCOMQ
alter index vdps2.iixduZwei on VDPS2.DTUNDERFIXCOMQ
create lob tablespace a123 in db123
create synonym syefgh for own123.taefgh
CREATE TABLE VDPS2.DTUNDERFIXCOMP
alter table oa1a038.twk003a
alter table gdb9998.twk003a
commit sdf sdf; CREATE TABLE "VDPS3 "
. -- sdf sdf
-- sdf
"vdps table drei " ; create alias efg.hik
-s silent: remove members wi
kommentar vorher
-- generating rebinds in DBAF at 14:21:19 20/10/06 for A540769
-- for 1 tablespace, 5 table, 0 view, 2 index, 1 alias, 1 synonym
-- tablespace DB123.A123
-- table VDPS2.DTUNDERFIXCOMQ
-- table VDPS2.DTUNDERFIXCOMP
-- table "VDPS3 "."vdps table drei "
-- table OA1A038.TWK003A
-- table GDB9998.TWK003A
-- index VDPS2.IIXDU
-- index VDPS2.IIXDUZWEI
-- alias EFG.HIK
-- synonym OWN123.SYEFGH
REBIND PACKAGE(DB.DBWK2.(DB2J000003));
-- vivo=BSNY con=17EF4F701D8D1B72 tst=2006-09-29-14.38.38.590494
REBIND PACKAGE(DB.DBWK2.(DB2J000ABC));
-- vivo=BSNY con=17EF50AF1ACF23CB tst=2006-09-29-15.58.43.647758
REBIND PACKAGE(DB.DBWK2.(DB2J000XYZ));
-- vivo=BSNY con=17EF50B10BBC328C tst=2006-09-29-15.58.56.607691
REBIND TRIGGER PACKAGE(DGDB9998.WK003TRIG);
-- vivo=BSYY con=17ECF6B005DF3C90 tst=2006-09-14-16.52.20.179834
---- compare 4 =, 0 new, 0 old, 0 others, total 4
--= REBIND PACKAGE(DB.DBWK2.(DB2J000003));
--= REBIND PACKAGE(DB.DBWK2.(DB2J000ABC));
--= REBIND PACKAGE(DB.DBWK2.(DB2J000XYZ));
--= REBIND TRIGGER PACKAGE(DGDB9998.WK003TRIG);