zOs/REXX.O13/DB2REVLO
/* rexx ****************************************************************
db2revlo: copy load infos from several db2SubSystems
parameter:
get <sd> from <s1> <s2> ...
<sd> destination db2 subsystem i.e. DBOL
<s1> <s2> ... source db2 subsystems
this rexx copies tuples
from sysibm.syscopy of the source subsystems <s1> <s2> ...
to revi.db2load of the destinatin subsystem <sd>
and deletes rows older then 222 days from this table
history:
2006.04.18 W.Keller new
***********************************************************************/
/*--- main code: analyse arguments and call work function ------------*/
parse arg args
parse source . . m.this.name .
/*--- configure constants ---*/
m.dTable = 'revi.db2Load'/* name of destination table */
m.retries = 3 /* max num of retries in retryHandler */
m.selSrcOnly = 500 /* max rows to fetch per transaction */
m.retentionDays = 222 /* delete rows older than so many days*/
m.insLimit = -1 /* stop inserting after so many rows */
if args = '' then do
args = 'get dbaf from dbTf dbaf'
say m.this.name 'setting test arguments' fun subDest cFr subSrc
end
say m.this.name 'analysing arguments:' args
parse upper var args fun subDest cFr subSrc
if cFr ^= 'FROM' then
call errHelp 'from missing in arguments:' args
if words(subSrc) < 1 then
call errHelp 'source db2 subsystems missing in arguments:' args
select
when fun == 'GET' then call retryHandler subDest, subSrc
when fun == 'DO' then do
call adrSqlConnect subDest
call doGet subDest <> subSrc, subSrc
if m.oldTuples & m.retentionDays > 0 then
call doDelete subSrc
call adrSqlDisconnect
end
otherwise call errHelp 'bad function' fun ,
'in arguments:' args
end
say m.this.name 'end'
exit 0
/*--- retryHandler: retry to get the date from each subsystem --------*/
retryHandler: procedure expose m.
parse arg dest, src
say '---' m.this.name 'retryHandler begin'
done = ''
do rx=1 to m.retries while src ^= ''
say '--- begin try' rx 'for' src
next = ''
do sx=1 to words(src)
s1 = word(src, sx)
say '--- try' rx 'from' s1
/* call get via tso not directly in rexx,
so we get an abend as a condition code back| */
cc = adrTso(m.this.name 'do' dest 'from' s1, '*')
if cc = 0 then do
say '--- ok from' s1
done = done s1
end
else do
say '--- error from' s1 'rc' cc
next = next s1
end
end
src = next
end
say '--- successfully got' dest 'from' done
if src ^= '' then do
say '--- failed getting' dest 'from' src
call err '--- failed getting' dest 'from' src
end
return
endProcedure retryHandler
doGet: procedure expose m.
parse upper arg otherLoc, src
cDup = 0
cIns = 0
cCom = 0
cSrc = 0
cRead = 0
firstTst = ''
lastTst = ''
m.oldTuples = 1
do forever
say time() 'preparing'
call doGetPrepare otherLoc, src
drop strt.
strt.tst = ''
strt.cnt = 0
/* select latest rows from destination */
call adrSql "open" m.selDestCrs
do forever
call adrSql m.selDestFetch
if sqlCode = 100 then
leave
/* say 'fetch dest:' expVars(m.columns) */
strt.dbname.tsname.dsnum.ictype.jobname.authid = 1
strt.tst = timestamp
strt.cnt = strt.cnt + 1
end
say time() 'startTimestamp' strt.tst 'with' strt.cnt 'tuples'
if strt.tst = '' then do
strt.tst = left(date(s),4)'-'substr(date(s), 5, 2) ,
|| '-01-00.00.00.000000'
say 'no old tuples setting startTimestamp to' strt.tst
m.oldTuples = 0
end
if strt.cnt >= m.selSrcOnly then
call err strt.cnt 'startTimestamp rows >=' m.selSrcOnly ,
'ROWS ONLY of select from' src
call adrSql "close" m.selDestCrs
/* select rows from source and insert them */
call adrSql "open" m.selSrcCrs "using :strt.tst"
cSrc = 0
do forever
call adrSql m.selSrcFetch
if sqlCode = 100 then
leave
cSrc = cSrc + 1
/* say 'fetch' src':' expVars(m.columns) */
if timestamp == strt.tst then do
if 'VAR' = symbol( ,
'strt.dbname.tsname.dsnum.ictype.jobname.authid') ,
then do
/* say 'same timestamp duplicate' */
cDup = cDup + 1
iterate
end
else do
/* say 'same timestamp not copied yet' */
end
end
call adrSql m.insDst
cIns = cIns + 1
if firstTst = '' then
firstTst = timestamp
lastTst = timestamp
end
call adrSql "close" m.selSrcCrs
call adrSql "commit"
cCom = cCom + 1
cRead = cRead + cSrc
say time() 'inserted' cIns', dups' cDup', read' cRead,
|| ', commits' cCom 'from' src
if cSrc < m.selSrcOnly then
leave
if m.insLimit > 0 then do
if cIns >= m.insLimit then do
say '--- insert Limit' m.insLimit 'reached, stopping'
leave
end
end
end
say '--- inserted' cIns', dups' cDup', read' cRead,
|| ', commits' cCom 'from' src
say ' from' firstTst 'to' lastTst
return
endProcedure doGet
/*--- prepare sql's --------------------------------------------------*/
doGetPrepare: procedure expose m.
parse upper arg otherLoc, src
cols = 'timestamp, dbname, tsname, dsnum, ictype, jobname, authid'
m.columns = cols
hCols = ':timestamp,:dbname,:tsname,:dsnum,:ictype,:jobname,:authid'
sTable = 'sysibm.sysCopy'
if otherLoc then
sTable = 'CHSKA000'src'.'sTable
/* select latest rows from dTable */
sql = "select" cols ,
"from" m.dTable ,
"where subsys = '"src"'",
"and timestamp =",
"( select max(timestamp)",
"from" m.dTable ,
"where subsys = '"src"'",
")"
call adrSql "prepare s1 from :sql", , sql
call adrSql "declare c1 cursor for s1"
m.selDestCrs = 'c1'
m.selDestFetch = 'fetch c1 into' hCols
/* select next rows from sTable */
sql = "select" cols ,
"from" sTable ,
"where timestamp >= ?",
"and timestamp < current timestamp - 10 minutes",
"and icType in ('P','R','S','W','X','Y','Z')",
"order by timestamp asc" ,
"fetch first" m.selSrcOnly "rows only"
call adrSql "prepare s2 from :sql", ,sql
call adrSql "declare c2 cursor for s2"
m.selSrcCrs = 'c2'
m.selSrcFetch = 'fetch c2 into' hCols
/* insert 1 row into dTable */
sql = "insert into" m.dTable ,
"(subSys, " cols")",
"values('"src"', ?, ?, ?, ?, ?, ?, ?)"
call adrSql "prepare s3 from :sql", ,sql
m.insDst = "execute s3 using" hCols
return
endProcedure doGetPrepare
doDelete: procedure expose m.
parse upper arg src
sql = "delete" ,
"from" m.dTable ,
"where subsys = '"src"'",
"and timestamp < current timestamp" ,
"-" m.retentionDays "days"
call adrSql "execute immediate :sql", , sql
cDel = sqlErrd.3
call adrSql "commit"
say '--- deleted' cDel 'rows older than' m.retentionDays 'days'
return
endProcedure doDelete
expVars:
parse arg ggVars
ggVars = translate(ggVars, ' ', ',')
ggRes = ''
do ggIx = 1 to words(ggVars)
ggWW = word(ggVars, ggIx)
ggRes = ggRes', 'ggWW'='value(ggWW)
end
if ggRes ^= '' then
ggRes = substr(ggRes, 3)
return ggRes
endSubroutine expVars
err:
parse arg ggMsg
say 'fatal error' ggMsg
if 'VAR' = symbol('m.selSrcCrs') then
call adrSql 'close' m.selSrcCrs, '*'
if 'VAR' = symbol('m.selDestCrs') then
call adrSql "close" m.selDestCrs, '*'
call adrSqlDisconnect '*'
call adrSqlDisconnect '*'
call errA ggMsg
endSubroutine err
/* copy adrIsp begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then do
ggSqlStmt = 'execSql' ggSqlStmt
if ggNo ^= '' then
ggNo = '==>' ggNo
end
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() 'for' ggSqlStmt 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
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x))':' ggSqlStmt
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
/**********************************************************************
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 'for' ggIspCmd
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 adr 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 */
/*--- 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 */
/*--- 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 adr 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 *****************************************************/