zOs/REXX.O13/EXDB2LOG
/* REXX */
/******************************************************************/
/* EXDB2LOG */
/* -------- */
/* */
/* 1 HISTORY: */
/* 18.04.2012 V2.2 rz8 und rzz integriert */
/* 17.04.2012 V2.1 truncate collids longer 18 */
/* 28.03.2008 V2.0 ABNORMAL EOT (G.KERN,A914227) */
/* 27.03.2008 V1.1 UNCOMMITED UOW (G.KERN,A914227) */
/* 27.03.2008 V1.2 CHECKPOINTS (G.KERN,A914227) */
/* 27.03.2008 V1.3 LOCK ESCALATION (G.KERN,A914227) */
/* 30.01.2008 V1.0 GRUNDVERSION (G.KERN,A914227) */
/* */
/* 2 PARMS EXDB2LOG <PARM1> */
/* PARM1 = DB2 SUBSYSTEM */
/* */
/* 3 LOCATION TSO.RZ?.P0.USER.EXEC */
/* */
/******************************************************************/
m.debug = 0 fds
m.wkTest = 1
call errReset 'h'
call errAddCleanup "if m.sql.conSSID <> '' then do;" ,
"say 'rollback';call sqlExec Rollback; call sqlRxDisconnect; end"
PARSE UPPER arg SSID .
/*----------------------------------------------------------------*/
/*-------------- VARIABLEN INITIALISIEREN ------------------------*/
/*----------------------------------------------------------------*/
if 0 then do /* online test ........ */
call resourceTypeIni
CALL sqlRxConnect dbtf
call readMstrLog
say m.to.0 'timeout deadlocks:'
cD = 0
cT = 0
do tx=1 to m.to.0
if m.to.tx.tst = '' ,
| m.to.tx.evTy = '' ,
| m.to.tx.v.dbMb = '' ,
| m.to.tx.v.plan = '' ,
| m.to.tx.v.conn = '' ,
| m.to.tx.v.corr = '' ,
| m.to.tx.h.dbMb = '' ,
| m.to.tx.h.plan = '' ,
| m.to.tx.h.conn = '' ,
| m.to.tx.h.corr = '' ,
| m.to.tx.reason = '' ,
| m.to.tx.type = '' ,
| m.to.tx.name = '' then do
say tx m.to.tx.tst ,
m.to.tx.evTy
say ' v' m.to.tx.v.dbMb ,
m.to.tx.v.plan ,
m.to.tx.v.conn ,
m.to.tx.v.corr
say ' h' m.to.tx.h.dbMb ,
m.to.tx.h.plan ,
m.to.tx.h.conn ,
m.to.tx.h.corr
say ' r' m.to.tx.reason ,
m.to.tx.type ,
m.to.tx.name
end
cD = cD + (m.to.tx.evTy == 'D')
cT = cT + (m.to.tx.evTy == 'T')
end
say 'dead' cD', timeO' cT', tot' m.to.0
call err 'end of tst'
end
tadmSSID = ''
ANZ_DDIN1 = 0
F_SSID = ''
F_DATUM = ''
F_TIME = ''
F_DATA = ''
CHECK_MAX_TST = ''
m.lastDeadlock = ''
m.lastTimeout = ''
SQL_MAX_TST_U = ''
SQL_MAX_TST_C = ''
SQL_MAX_TST_E = ''
SQL_MAX_TST_A = ''
m.tadmCreator = ''
SQL_DBID = ''
SQL_OBID = ''
SQL_DOT = ''
SQL_DBID_OBJECT = ''
SQL_OBID_OBJECT = ''
EVENT_SSID = ''
EVENT_DATE = ''
EVENT_TYPE = ''
EVENT_V_PLAN = ''
EVENT_V_CORRID = ''
EVENT_V_CONNID = ''
EVENT_S_PLAN = ''
EVENT_S_CORRID = ''
EVENT_S_CONNID = ''
EVENT_REASON = ''
EVENT_O_TYPE = ''
EVENT_O_NAME = ''
EVENT_UOW_SSID = ''
EVENT_UOW_DATE = ''
EVENT_UOW_TYPE = ''
EVENT_UOW_LOGREC = ''
EVENT_UOW_CORRID = ''
EVENT_UOW_CONNID = ''
EVENT_UOW_PLAN = ''
EVENT_UOW_AUTHID = ''
EVENT_LES_SSID = ''
EVENT_LES_DATE = ''
EVENT_LES_TYPE = ''
EVENT_LES_PLAN = ''
EVENT_LES_PACKAGE = ''
EVENT_LES_COLLID = ''
EVENT_LES_CORRID = ''
EVENT_LES_CONNID = ''
EVENT_LES_RESOURCE = ''
EVENT_LES_LOCKSTATE = ''
EVENT_LES_STATEMENT = ''
EVENT_EOT_SSID = ''
EVENT_EOT_DATE = ''
EVENT_EOT_TYPE = ''
EVENT_EOT_USER = ''
EVENT_EOT_CONNID = ''
EVENT_EOT_CORRID = ''
EVENT_EOT_JOBNAME = ''
EVENT_EOT_ASID = ''
EVENT_EOT_TCB = ''
CNT_OUTPUT = 1
CNT_OUTPUT_UOW = 1
CNT_OUTPUT_LES = 1
CNT_OUTPUT_EOT = 1
/*----------------------------------------------------------------*/
/*-------------- PROGRAMM-PARAMETER VERARBEITEN ------------------*/
/*----------------------------------------------------------------*/
SAY "PROGRAMMVERSION = v2.2 vom 18.4.12"
SAY "DB2 SUBSYSTEM = "SSID
/*----------------------------------------------------------------*/
/*-------------- HAUPTPROGRAMM -----------------------------------*/
/*----------------------------------------------------------------*/
CALL OWNER_SSID_ZUWEISEN /* ZUWEISEN VON OWNER & SSID FÜR SQL*/
CALL sqlRxConnect tadmSSID /* DB2 SUBSYSTEM VERBINDEN */
CALL GET_MAX_WERT_TIMEOUT /* MAX TIMEOUT EINTRAG VON TABELLE LESEN */
CALL GET_MAX_WERT_DEADLOCK /* MAX DEADLOCK EINTRAG VON TABELLE LESEN */
CALL GET_MAX_WERT_UNCOMUOW /* MAX UNCOMUOW EINTRAG VON TABELLE L*/
CALL GET_MAX_WERT_CHECKPNT /* MAX CHECKPNT EINTRAG VON TABELLE L*/
CALL GET_MAX_WERT_LOCKESCA /* MAX LOCKESCA EINTRAG VON TABELLE L*/
CALL GET_MAX_WERT_EOT /* MAX EOT EINTRAG VON TABELLE LESEN */
CALL sqlRxDisconnect /* DISCONNECT DB2 SUBSYSTEM */
call resourceTypeIni
CALL sqlRxConnect ssid /* DB2 SUBSYSTEM VERBINDEN */
CALL readMstrLog /* INPUT-DS lesen und analysieren */
if 0 then do
CALL READ_TIMEOUT /* TIMEOUTS AUS INPUT-DS LESEN */
CALL READ_DEADLOCK /* TIMEOUTS AUS INPUT-DS LESEN */
CALL ZUWEISUNG_TYPE /* RESOURCE TYPE ZUWEISEN */
CALL SELECT_DBID_OBID /* DBID/OBID SELEKTIEREN */
CALL READ_UNCOMMITED_UOW /* UNCOMMITED UOW AUS INPUT-DS LESEN */
CALL READ_CHECKPOINT /* CHECKPOINTS AUS INPUT-DS LESEN */
CALL READ_LOCKESCALATION /* LOCK ESCALATION AUS INPUT-DS LESEN */
CALL READ_EOT /* ABNORMAL EOT AUS INPUT-DS LESEN */
end
CALL sqlRxDisconnect /* DISCONNECT DB2 SUBSYSTEM */
CALL sqlRxConnect tadmSSID /* DB2 SUBSYSTEM VERBINDEN */
CALL INSERT_TADM60A1 /* INSERT IN DB2 TABELLE */
if 0 then do
CALL INSERT_TADM63A1 /* INSERT IN DB2 TABELLE */
CALL INSERT_TADM64A1 /* INSERT IN DB2 TABELLE */
CALL INSERT_TADM65A1 /* INSERT IN DB2 TABELLE */
end
CALL sqlRxDisconnect /* DISCONNECT DB2 SUBSYSTEM */
EXIT;
/*----------------------------------------------------------------*/
/*-------------- OWNER UND SSID FÜR SQL ABFRAGE ZUWEISEN --------*/
/*----------------------------------------------------------------*/
OWNER_SSID_ZUWEISEN:
IF m.debug THEN SAY "ENTER PROCEDURE OWNER_SSID_ZUWEISEN..."
SELECT
WHEN SSID = 'DBAF' THEN info = 'DAF OA1A DBAF' /* rz1 */
WHEN SSID = 'DBTF' THEN info = 'DTF OA1A DBAF'
WHEN SSID = 'DBZF' THEN info = 'DZF OA1A DBAF'
WHEN SSID = 'DBOC' THEN info = 'DOC OA1A DBAF'
WHEN SSID = 'DBBA' THEN info = 'DBA OA1A DBAF'
WHEN SSID = 'DBLF' THEN info = 'DLF OA1A DBAF'
WHEN SSID = 'DVTB' THEN info = 'DTB OA1A DBAF'
WHEN SSID = 'DP2G' THEN info = 'DP2 OA1P DP2G' /* rz2 */
WHEN SSID = 'DBOF' THEN info = 'DOF OA1P DP2G'
WHEN SSID = 'DVBP' THEN info = 'DBP OA1P DP2G'
WHEN SSID = 'DC0G' THEN info = 'DC0 OA1P DC0G' /* rz8 */
WHEN SSID = 'DCVG' THEN info = 'DCV OA1P DCVG'
WHEN SSID = 'DD0G' THEN info = 'DD0 OA1P DD0G'
WHEN SSID = 'DDVG' THEN info = 'DDV OA1P DDVG'
WHEN SSID = 'DX0G' THEN info = 'DX0 OA1P DX0G'
WHEN SSID = 'DP8G' THEN info = 'DP8 OA1P DP8G'
WHEN SSID = 'DE0G' THEN info = 'DE0 OA1P DE0G'
WHEN SSID = 'DEVG' THEN info = 'DEV OA1P DEVG'
OTHERWISE do
say "error: bad ssid = '"ssid"'"
exit 20
end
END
parse var info m.db2Member3 m.tadmCreator tadmSSID .
if m.wkTest then do
m.tadmCreator = A540769
say '?????? wktest run'
end
say ' ssid' ssid 'member' m.db2Member3'?',
'to' tadmSSID':'m.tadmCreator'.TADM6*A1'
IF m.debug THEN SAY "LEAVE PROCEDURE OWNER_SSID_ZUWEISEN..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX TIMEOUT WERT VON TADM60A1 LESEN -------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_TIMEOUT: procedure expose m.
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_TIMEOUT..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM60A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'T' "
SQLTEXT = SQLMAX
ADDRESS DSNREXX "EXECSQL DECLARE C3 CURSOR FOR S3"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S3 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C3"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C3 INTO :m.lastTimeout :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX TIMEOUT TIMESTAMP FOR" SSID "IS:" m.lastTimeout
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_TIMEOUT..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX DEADLOCK WERT VON TADM60A1 LESEN ------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_DEADLOCK: procedure expose m.
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_DEADLOCK..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM60A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'D' "
SQLTEXT = SQLMAX
ADDRESS DSNREXX "EXECSQL DECLARE C2 CURSOR FOR S2"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S2 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C2"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C2 INTO :m.lastDeadlock :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX DEADLOCK TIMESTAMP FOR" SSID "IS:" m.lastDeadlock
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_DEADLOCK..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX UNCOMUOW WERT VON TADM63A1 LESEN ------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_UNCOMUOW:
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_UNCOMUOW..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM63A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'U' "
SQLTEXT = SQLMAX_DEADLOCK
ADDRESS DSNREXX "EXECSQL DECLARE C7 CURSOR FOR S7"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S7 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C7"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C7 INTO :SQL_MAX_TST_U :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX UNCOMMITED UOW TIMESTAMP FOR" SSID "IS:" SQL_MAX_TST_U
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_UNCOMUOW..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX CHECKPNT WERT VON TADM63A1 LESEN ------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_CHECKPNT:
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_CHECKPNT..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM63A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'C' "
SQLTEXT = SQLMAX_DEADLOCK
ADDRESS DSNREXX "EXECSQL DECLARE C9 CURSOR FOR S9"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S9 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C9"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C9 INTO :SQL_MAX_TST_C :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX CHECKPOINT TIMESTAMP FOR" SSID "IS:" SQL_MAX_TST_C
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_CHECKPNT..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX LOCKESCA WERT VON TADM64A1 LESEN ------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_LOCKESCA:
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_LOCKESCA..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM64A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'E' "
SQLTEXT = SQLMAX_DEADLOCK
ADDRESS DSNREXX "EXECSQL DECLARE C10 CURSOR FOR S10"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S10 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C10"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C10 INTO :SQL_MAX_TST_E :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX LOCK ESCALATION TIMESTAMP FOR" SSID "IS:" SQL_MAX_TST_E
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_LOCKESCA..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- MAX EOT WERT VON TADM65A1 LESEN -----------------*/
/*----------------------------------------------------------------*/
GET_MAX_WERT_EOT:
IF m.debug THEN SAY "ENTER PROCEDURE GET_MAX_WERT_EOT..."
SQLMAX= "SELECT ",
" MAX(TIMESTAMP) ",
" FROM "m.tadmCreator".TADM65A1 ",
" WHERE SSID LIKE '"m.db2Member3"%'",
" AND EVENT_TYPE = 'A' "
SQLTEXT = SQLMAX_DEADLOCK
ADDRESS DSNREXX "EXECSQL DECLARE C12 CURSOR FOR S12"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S12 FROM :SQLMAX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C12"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C12 INTO :SQL_MAX_TST_A :SQL_IND"
IF SQLCODE <> 0 THEN CALL SQLCA
SAY " MAX ABNORMAL EOT TIMESTAMP FOR" SSID "IS:" SQL_MAX_TST_A
IF m.debug THEN SAY "LEAVE PROCEDURE GET_MAX_WERT_EOT..."
RETURN
/*--- read the whole master log
and analyse each interesting msg --------------------------*/
readMstrLog:
call readNxBegin rd, '-', 'DDIN1'
li = readNx(rd)
m.to.0 = 0
do lx=1 to 12e12 while li <> ''
mid = isDsnMsg(m.li, msgI)
if mid == '' then do
li = readNx(rd)
iterate
end
if mid == 'DSNT375I' then
call anaTimeoutDeadlock rd, msgI, 'D'
else if mid == 'DSNT376I' then
call anaTimeoutDeadlock rd, msgI, 'T'
else if mid == 'DSNT501I' then
call anaResourceNotAvailable rd, msgI
l2 = readNxCur(rd)
if li == l2 then
li = readNx(rd)
else
li = l2
/* say lx li mid'>>>' m.li
*/ end
say 'readMstrLog end:' readNxPos(rd)
call readNxEnd rd
return
endProcedure readMstrLog
/*--- if this is not a dsn message return ''
otherwise, check it, collect infos into info and return id ----*/
isDsnMsg: procedure expose m.
parse arg line, info
mid = word(line, 4)
if \ abbrev(mid, 'DSN') | wordIndex(line, 4) <> 29 ,
| length(mid) > 8 then do
if mid = '----' then
if word(line, 5) = 'IAT6853' then
call anaCurDate line
return ''
end
parse var line m.info.dbMb m.info.date m.info.time .
m.info.tst = m.info.date'-'translate(m.info.time, '.', ':')
m.info.head = left(line,27)
if '-'m.info.dbMb \== word(line, 5) then
call err 'dbMember mismatch: ' readNxPos(rd)
return mid
endProcedure isDsnMsg
/* analyse current date in iat6853 message
and check that it equals the header ---------------------------*/
anaCurDate: procedure expose m.
parse arg line
if substr(line, 40, 21) ,
<> ' THE CURRENT DATE IS ' then
call err 'bad IAT6853' readNxPos(rd)
d1 = subword(substr(line, 61), 2, 3)
say '???' left(line, 59) '>>>' d1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
d2 = word(d1, 1) ,
translate(left(word(d1, 2), 1)),
|| translate(substr(word(d1, 2), 2),
, m.mAlfLC, m.mAlfUC) ,
word(d1, 3)
d3 = date('s', d2)
if translate('1234-56-78', d3, '12345678') <> word(line, 2) then
call err 'date mismatch' word(line, 2) '<>' d3 'line': line
return
endProcedure anaCurDate
/*--- analye timeout, deadlock msg: DSNT375I, DSNT376I ---------------*/
anaTimeoutDeadlock: procedure expose m.
parse arg rd, info, pEvTy
li = readNxCur(rd)
if pEvTy == 'D' then
if m.info.tst <= m.lastDeadlock then
return
if pEvTy == 'T' then
if m.info.tst <= m.lastTimeout then
return
totx = newTimeout(info, pEvTy)
vs = 'V'
do forever /* jede Zeile der Message */
if pos(' ONE HOLDER ', m.li) > 0 then do
if pEvTy <> 'T' then
call err 'holder for evTy' pEvTy':'readNxPos(r)
else if vs <> 'V' then
call err 'several holders:'readNxPos(r)
else
vs = 'H'
end
if pos(' IS DEADLOCKED ', m.li) > 0 then do
if pEvTy <> 'D' then
call err 'is deadLocked for evTy' pEvTy':'readNxPos(r)
else if vs <> 'V' then
call err 'several is deadLocked:'readNxPos(r)
else
vs = 'H'
end
cx = pos(' PLAN=', m.li)
if cx > 0 then
m.toTx.vs.plan = word(substr(m.li, cx+6,8), 1)
cx = pos(' CORRELATION-ID=', m.li)
if cx > 0 then
m.toTx.vs.corr = strip(substr(m.li, cx+16))
cx = pos(' CONNECTION-ID=', m.li)
if cx > 0 then
m.toTx.vs.conn = strip(substr(m.li, cx+15))
cx = pos(' ON MEMBER ', m.li)
if cx > 0 then do
if vs <> 'H' then
call err 'on member in vs' vs':' readNxPos(rd)
else
m.toTx.vs.dbMb = word(substr(m.li, cx+11, 8), 1)
end
li = readNx(rd) /* nächste Zeile */
if \ abbrev(m.li, m.info.head) then
return
if substr(m.li, 29, 8) <> '' then
if isDsnMsg(m.li, msgI) <> '' then
return
end /* jede Zeile der Message */
/*say 'v' m.toTx.v.dbMb m.toTx.v.plan m.toTx.v.corr m.toTx.v.conn
say 's' m.toTx.h.dbMb m.toTx.h.plan m.toTx.h.corr m.toTx.h.conn */
endProcedure anaTimeOut
/*--- make and initialise a new timeout/deadlock row -----------------*/
newTimeout: procedure expose m.
parse arg info, pEvTy
m.to.0 = m.to.0 + 1
toTx = 'TO.'m.to.0
m.toTx.tst = m.info.tst
m.toTx.evTy = pEvTy
m.toTx.v.dbMb = m.info.dbMb
m.toTx.v.plan = ''
m.toTx.v.conn = ''
m.toTx.v.corr = ''
m.toTx.h.dbMb = ''
m.toTx.h.plan = ''
m.toTx.h.conn = ''
m.toTx.h.corr = ''
m.toTx.reason = ''
m.toTx.type = ''
m.toTx.name = ''
return toTx
endProcedure newTimeout
/*--- analye resourceNotAvailable msg DSNT501I -----------------------*/
anaResourceNotAvailable: procedure expose m.
parse arg rd, info
tCor = ''
tCon = ''
tRea = ''
tTyp = ''
tNam = ''
do forever /* loop line of dsnt501i */
cx = pos(' CORRELATION-ID=', m.li)
if cx > 0 then
tCor = word(substr(m.li,cx+16),1)
cx = pos(' CONNECTION-ID=', m.li)
if cx > 0 then
tCon = strip(substr(m.li,cx+15))
cx = pos(' REASON ', m.li)
if cx > 0 then
tRea = word(substr(m.li,cx+8,20),1)
cx = pos(' TYPE ', m.li)
if cx > 0 then
tTyp = word(substr(m.li,cx+6,20),1)
cx = pos(' NAME ', m.li)
if cx > 0 then
tNam = strip(substr(m.li,cx+6))
li = readNx(rd)
if \ abbrev(m.li, m.info.head) then
leave
if substr(m.li, 29, 8) <> '' then
if isDsnMsg(m.li, msgI) <> '' then
leave
end /* loop line of dsnt501i */
/* search preceeding to/dead */
tt = max(1, m.to.0 - 20)
do tx=m.to.0 to tt by -1 ,
while m.to.tx.v.corr \== tCor | m.to.tx.v.conn \== tCon ,
| m.to.tx.name \== ''
end
if tx >= tt then
toTx = 'TO.'tx
else
return /* ??? new feature: store these also
evType depending on reason, but some have several */
m.toTx.type = tTyp
m.toTx.name = space(tNam, 1)
m.toTx.reason = tRea
if tTyp <> '' then
call resourceType toTx'.'type, toTx'.'name
return
endProcedure anaResourceNotAvailable
/*--- give the name of the resourcetype and dbid/obid ----------------*/
resourceType: procedure expose m.
parse arg tp, nm
cd = m.tp
if symbol('m.resourceType.cd') <> 'VAR' then do
trace ?r
say '<'cd'>' c2x(cd)
call err 'unknown resource type' cd
end
m.tp = m.resourceType.cd
parms = m.resourceTypeParms.cd
names = m.nm
if pos('DI.OI', parms) > 0 then do
px = 0
nx = 0
do until px = 0
py = pos('.', parms, px + 1)
ny = pos('.', names, nx + 1)
if (py=0) <> (ny=0) then
call err 'resource parms' parms 'mismatch name' names
if py = 0 then do
p1 = substr(parms, px+1)
n1 = substr(names, nx+1)
end
else do
p1 = substr(parms, px+1, py-px-1)
n1 = substr(names, nx+1, ny-nx-1)
end
n.p1 = n1
px = py
nx = ny
end
m.nm = getDbidObid(n.di, n.oi) names
end
return cd
endProcedure resourceType
resourceTypeIni: procedure expose m.
/* the old definitions for backward compability */
call rtDef '00000100', 'DB'
call rtDef '00000200', 'TS'
call rtDef '00000201', 'IX-SPACE'
call rtDef '00000202', 'TS'
call rtDef '00000210', 'PARTITION'
call rtDef '00000220', 'DATASET'
call rtDef '00000230', 'TEMP FILE'
call rtDef '00000300', 'TEMP FILE'
call rtDef '00000300', 'PAGE'
call rtDef '00000301', 'IX-MINIPAGE'
call rtDef '00000302', 'TS-PAGE'
call rtDef '00000303', 'IX-PAGE'
call rtDef '00000304', 'TS-RID'
call rtDef '00000D01', 'DBID/OBID'
call rtDef '00000800', 'PLAN'
call rtDef '00000801', 'PACKAGE'
call rtDef '00002000', 'TS CS-CLAIM CLASS'
call rtDef '00002001', 'TS RR-CLAIM CLASS'
call rtDef '00002002', 'TS WRITE-CLAIM CLASS'
call rtDef '00002003', 'IX CS-CLAIM CLASS'
call rtDef '00002004', 'IX RR-CLAIM CLASS'
call rtDef '00002005', 'IX WRITE-CLAIM CLASS'
call rtDef '00002006', 'TS PART CS-CLAIM CLASS'
call rtDef '00002007', 'TS PART RR-CLAIM CLASS'
call rtDef '00002008', 'TS PART WRITE-CLAIM CLASS'
call rtDef '00002009', 'IX PART CS-CLAIM CLASS'
call rtDef '00002010', 'IX PART RR-CLAIM CLASS'
call rtDef '00002011', 'IX PART WRITE-CLAIM CLASS'
/* the complete Db2V10 resource type table */
call rtDef '00000100', 'Database', 'DB'
call rtDef '00000200', 'Table space', 'DB.SP'
call rtDef '00000201', 'Index space', 'DB.SP'
call rtDef '00000202', 'Table space RD.DB.TS'
call rtDef '00000205', 'Compression Dictionary', 'DB.SP'
call rtDef '00000210', 'Partition', 'DB.SP.PT'
call rtDef '00000220', 'Data set', 'DSN'
call rtDef '00000230', 'Temporary file', 'SZ'
call rtDef '00000240', 'Database procedure', 'DBP'
call rtDef '00000300', 'Page', 'DB.SP.PG'
call rtDef '00000301', 'Index minipage', 'DB.SP.PG.MP'
call rtDef '00000302', 'Table space page', 'DB.SP.PG'
call rtDef '00000303', 'Index space page', 'DB.SP.PG'
call rtDef '00000304', 'Table space RID', 'DB.SP.RID'
call rtDef '00000305', 'Index access/table space RID', 'DB.SP.RID'
call rtDef '00000306', 'Index access/table space page', 'DB.SP.PG'
call rtDef '00000307', 'Index space EOF', 'DB.SP.01'
call rtDef '00000400', 'ICF catalog', 'IC'
call rtDef '00000401', 'Authorization function'
call rtDef '00000402', 'Security Server',
, 'SAF/RACF return/reason codes'
call rtDef '00000500', 'Storage group', 'SG'
call rtDef '00000602', 'EDM DBD Space'
call rtDef '00000603', 'EDM DYNAMIC STATEMENT Space'
call rtDef '00000604', 'EDM skeleton storage'
call rtDef '00000605', 'EDM above-the-bar storage'
call rtDef '00000606', 'EDM below-the-bar storage'
call rtDef '00000700', 'Buffer pool space', 'BP'
call rtDef '00000701', 'Group buffer pool', 'GBP'
call rtDef '00000800', 'Plan', 'PL'
call rtDef '00000801', 'Package', 'COLLECTION.PACKAGE.CONTOKEN'
call rtDef '00000802', 'BINDLOCK01 through BINDLOCK20',
, 'BINDLOCK01 through BINDLOCK20'
call rtDef '00000900', '32KB data area'
call rtDef '00000901', 'Sort storage'
call rtDef '00000903', 'Hash anchor', 'DB.SP.PG.AI'
call rtDef '00000904', 'RIDLIST storage'
call rtDef '00000905', 'IRLM storage'
call rtDef '00000906', 'DB2', 'MEMBER'
call rtDef '00000907', 'LOB storage'
call rtDef '00000908', 'Basic Floating Point Extensions Facility'
call rtDef '00000909', 'Extended Time-of-Day (TOD) Clock'
call rtDef '0000090A', 'XML storage'
call rtDef '00000A00', 'Table', 'RD.CR.TB'
call rtDef '00000A10', 'Alias', 'RELDEP.OWNER.ALIAS.RD.CR.AL'
call rtDef '00000A11', 'Distinct type', 'SC.DT'
call rtDef '00000A12', 'User-defined function', 'SC.SN'
call rtDef '00000A13', 'Stored procedure', 'SC.SN'
call rtDef '00000A14', 'Sequence'
call rtDef '00000A16', 'Role'
call rtDef '00000A17', 'Trigger'
call rtDef '00000B00', 'View', 'RD.CR.VW'
call rtDef '00000C00', 'Index', 'RD.CR.IX'
call rtDef '00000C01', 'Index', 'CR.IX'
call rtDef '00000D00', 'DBID/OBID', 'RD.DI.OI'
call rtDef '00000D01', 'DBID/OBID', 'DI.OI'
call rtDef '00000D02', 'OBID', 'OI'
call rtDef '00000E00', 'SU limit exceeded', 'CN'
call rtDef '00000F00', 'Auxiliary column',
,'DI.OI.ROWID.COLN or DI.OI.DOCID.COLN'
call rtDef '00000F01', 'LOB lock', 'DIX.PIX.ROWID.VRSN'
call rtDef '00000F81', 'XML lock', 'DIX.PIX.DOCID'
call rtDef '00001000', 'DDF', 'LOCATION or SUBSYSTEM ID'
call rtDef '00001001', 'System conversation',
, 'LU.MODE.RTNCD.FDBK2.RCPRI.RCSEC.SENSE'
call rtDef '00001002', 'Agent conversation',
, 'LU.MODE.RTNCD.FDBK2.RCPRI.RCSEC.SENSE'
call rtDef '00001003', 'CNOS processing',
, 'LU.MODE.RTNCD.FDBK2.RCPRI.RCSEC.SENSE'
call rtDef '00001004', 'CDB (Communication database)',
, 'LOCATION.AUTHORIZATIONID.PL'
call rtDef '00001005', 'DB access agent', 'LOCATION'
call rtDef '00001007', 'TCP/IP domain name', 'LINKNAME.DOMAIN.ERRNO'
call rtDef '00001008', 'TCP/IP service name', 'LOCATION.SERVICE.ERRNO'
call rtDef '00001080', 'ACCEL', 'SERVER.DOMAIN'
call rtDef '00001102', 'Bootstrap data set (BSDS)', 'MEMBER'
call rtDef '00002000', 'Table space CS-claim class', 'DB.SP'
call rtDef '00002001', 'Table space RR-claim class', 'DB.SP'
call rtDef '00002002', 'Table space write-claim class', 'DB.SP'
call rtDef '00002003', 'Index space CS-claim class', 'DB.SP'
call rtDef '00002004', 'Index space RR-claim class', 'DB.SP'
call rtDef '00002005', 'Index space write-claim class', 'DB.SP'
call rtDef '00002006', 'Table space partition CS-claim class',
, 'DB.SP.PT'
call rtDef '00002007', 'Table space partition RR-claim class',
, 'DB.SP.PT'
call rtDef '00002008', 'Table space partition write-claim class',
, 'DB.SP.PT'
call rtDef '00002009', 'Index space partition CS-claim class',
, 'DB.SP.PT'
call rtDef '00002010', 'Index space partition RR-claim class',
, 'DB.SP.PT'
call rtDef '00002011', 'Index space partition Write-claim class',
, 'DB.SP.PT'
call rtDef '00002100', 'Table space DBET entry', 'DB.SP'
call rtDef '00002101', 'Index space DBET entry', 'DB.SP'
call rtDef '00002102', 'Table space partition DBET entry', 'DB.SP.PT'
call rtDef '00002103', 'Index space partition DBET entry', 'DB.SP.PT'
call rtDef '00002104', 'DBET hash chain lock timeout',
, 'INTERNAL LOCK NN'
call rtDef '00002105', 'Logical partition DBET entry', 'DB.SP.PT'
call rtDef '00002200', 'Routine Parameter Storage', 'DBP'
call rtDef '00002201', 'm.debug Agent Storage', 'DBP'
call rtDef '00002300', 'ICSF encryption and decryption facilities'
call rtDef '00003000', 'Code (release maintenance_level or system' ,
'parameter)', 'REL,APAR,ZPARM'
call rtDef '00003002', 'Number of Stored Procedures'
call rtDef '00003072', 'Index'
call rtDef '00003073', 'Index'
call rtDef '00003328', 'Release dependency'
call rtDef '00003329', 'DBID/OBID', 'DI.OI'
call rtDef '00003330', 'OBID limit exceeded'
call rtDef '00003840', 'LOB column'
call rtDef '00004000', 'Profile exception threshold exceeded',
, 'PID.PTYPE.PNAME'
return
endProcedure resourceTypeIni
rtDef: procedure expose m.
parse arg cd, nm, pa
if symbol('m.resourceType.cd') <> 'VAR' then
m.resourceType.cd = nm
m.resourceTypeParms.cd = pa
return
endProcedure rtDef
getDbidObid: procedure expose m.
parse arg dbid, obid
SQL_DBID = STRIP(dbid,L,0)
SQL_OBID = STRIP(obid,L,0)
if symbol('m.dbidObid.dbid.obid') <> 'VAR' then do
/* select from catalog */
/* from sysTables */
SQL_TB= "SELECT ",
" STRIP(CREATOR,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSTABLES ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_TB
ADDRESS DSNREXX "EXECSQL DECLARE C4 CURSOR FOR S4"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S4 FROM :SQL_TB"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C4"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C4 INTO :SQL_DBID_OBID :SQL_IND"
sqlFet = sqlCode
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C4"
/*IF NOT FOUND GO AND CHECK THE SYSIBM.SYSTABLESPACE*/
IF SQLFet = 100 THEN DO /* from sysTablespace */
SQL_TS= "SELECT ",
" STRIP(DBNAME,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSTABLESPACE ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_TS
ADDRESS DSNREXX "EXECSQL DECLARE C5 CURSOR FOR S5"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S5 FROM :SQL_TS"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C5"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C5 INTO :SQL_DBID_OBID :SQL_IND"
sqlFet = sqlCode
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C5"
END /* from sysTablespace */
/*IF NOT FOUND GO AND CHECK THE SYSIBM.INDEXES*/
IF sqlFet = 100 THEN DO /* from sysIndexes */
SQL_IX= "SELECT ",
" STRIP(CREATOR,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSINDEXES ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_IX
ADDRESS DSNREXX "EXECSQL DECLARE C6 CURSOR FOR S6"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S6 FROM :SQL_IX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C6"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C6 INTO :SQL_DBID_OBID :SQL_IND"
if sqlCode <> 0 then
sql_dbid_obid = '???'
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C6"
END /* from sysIndexes */
m.dbidObid.dbid.obid = sql_dbid_obid
SAY "??? " SQL_DBID_OBID,
"SELEKTIERT FÜR DBID" SQL_DBID ", OBID" SQL_OBID
end /* select from catalog */
return m.dbidObid.dbid.obid
endProcedure getDbidObid
/*----------------------------------------------------------------*/
/*-------------- DATASETS EINLESEN, DDNAME ZUORDNEN --------------*/
/*----------------------------------------------------------------*/
READ_DSN:
IF m.debug THEN SAY "ENTER PROCEDURE READ_DSN..." ,
TIME() "CPU" STRIP(SYSVAR(SYSCPU))
/* DDIN1 EINLESEN */
"EXECIO * DISKR DDIN1 (STEM DDIN1. FINIS"
IF m.debug THEN SAY "ENTER PROCEDURE READ" DDIN1.0 ,
TIME() "CPU" STRIP(SYSVAR(SYSCPU))
ANZ_DDIN1 = DDIN1.0 /* ANZAHL INPUT-LINIEN */
/* LESE DATASET-INFO ZU DDNAME */
DO CNT_LINE_DDIN1 = 1 TO DDIN1.0
PARSE VAR DDIN1.CNT_LINE_DDIN1 F_SSID.CNT_LINE_DDIN1,
F_DATE.CNT_LINE_DDIN1,
F_TIME.CNT_LINE_DDIN1,
F_DATA_1.CNT_LINE_DDIN1,
F_DATA_2.CNT_LINE_DDIN1,
F_DATA_3.CNT_LINE_DDIN1,
F_DATA_4.CNT_LINE_DDIN1,
F_DATA_5.CNT_LINE_DDIN1,
F_DATA_6.CNT_LINE_DDIN1,
F_DATA_7.CNT_LINE_DDIN1,
F_DATA_8.CNT_LINE_DDIN1,
F_DATA_9.CNT_LINE_DDIN1,
F_DATA_10.CNT_LINE_DDIN1,
F_DATA_11.CNT_LINE_DDIN1,
F_DATA_12.CNT_LINE_DDIN1
CHECK_MAX_TST.CNT_LINE_DDIN1 = F_DATE.CNT_LINE_DDIN1||,
'-'||,
SUBSTR(F_TIME.CNT_LINE_DDIN1,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE_DDIN1,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE_DDIN1,7,2)||,
'.000000'
F_DATA_1.CNT_LINE_DDIN1 = STRIP(F_DATA_1.CNT_LINE_DDIN1,B)
F_DATA_2.CNT_LINE_DDIN1 = STRIP(F_DATA_2.CNT_LINE_DDIN1,B)
F_DATA_3.CNT_LINE_DDIN1 = STRIP(F_DATA_3.CNT_LINE_DDIN1,B)
F_DATA_4.CNT_LINE_DDIN1 = STRIP(F_DATA_4.CNT_LINE_DDIN1,B)
F_DATA_5.CNT_LINE_DDIN1 = STRIP(F_DATA_5.CNT_LINE_DDIN1,B)
F_DATA_6.CNT_LINE_DDIN1 = STRIP(F_DATA_6.CNT_LINE_DDIN1,B)
F_DATA_7.CNT_LINE_DDIN1 = STRIP(F_DATA_7.CNT_LINE_DDIN1,B)
F_DATA_8.CNT_LINE_DDIN1 = STRIP(F_DATA_8.CNT_LINE_DDIN1,B)
F_DATA_9.CNT_LINE_DDIN1 = STRIP(F_DATA_9.CNT_LINE_DDIN1,B)
F_DATA_10.CNT_LINE_DDIN1 = STRIP(F_DATA_10.CNT_LINE_DDIN1,B)
F_DATA_11.CNT_LINE_DDIN1 = STRIP(F_DATA_11.CNT_LINE_DDIN1,B)
F_DATA_12.CNT_LINE_DDIN1 = STRIP(F_DATA_12.CNT_LINE_DDIN1,B)
END
IF m.debug THEN SAY "LEAVE PROCEDURE READ_DSN..." ,
TIME() "CPU" STRIP(SYSVAR(SYSCPU))
RETURN
/*----------------------------------------------------------------*/
/*-------------- TIMEOUTS AUS INPUT-DS LESEN ---------------------*/
/*----------------------------------------------------------------*/
READ_TIMEOUT:
IF m.debug THEN SAY "ENTER PROCEDURE READ_TIMEOUT..."
TIMEOUTS_READ = 0
VICTIM_PLAN_FOUND = 'N'
VICTIM_CORRID_FOUND = 'N'
VICTIM_CONN_FOUND = 'N'
SOURCE_PLAN_FOUND = 'N'
SOURCE_CORRID_FOUND = 'N'
SOURCE_CONN_FOUND = 'N'
NAME_READ = 'N'
TIMEOUT_OK = 'Y'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSNT376I' &,
CHECK_MAX_TST.CNT_LINE > m.lastTimeout THEN DO
TIMEOUTS_READ = TIMEOUTS_READ + 1
EVENT_SSID.CNT_OUTPUT = F_SSID.CNT_LINE
EVENT_DATE.CNT_OUTPUT = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_TYPE.CNT_OUTPUT = 'T'
DO FOREVER
IF SUBSTR(F_DATA_10.CNT_LINE,1,4) = 'PLAN' &,
VICTIM_PLAN_FOUND = 'Y' &,
SOURCE_PLAN_FOUND = 'N' THEN DO
EVENT_S_PLAN.CNT_OUTPUT = ,
SUBSTR(F_DATA_10.CNT_LINE,6)
SOURCE_PLAN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,11) = 'CORRELATION' &,
VICTIM_CORRID_FOUND = 'Y' &,
SOURCE_CORRID_FOUND = 'N' THEN DO
EVENT_S_CORRID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,16)
SOURCE_CORRID_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,10) = 'CONNECTION' &,
VICTIM_CONN_FOUND = 'Y' &,
SOURCE_CONN_FOUND = 'N' THEN DO
EVENT_S_CONNID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,15)
SOURCE_CONN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_3.CNT_LINE,1,4) = 'PLAN' &,
VICTIM_PLAN_FOUND = 'N' &,
SOURCE_PLAN_FOUND = 'N' THEN DO
EVENT_V_PLAN.CNT_OUTPUT = ,
SUBSTR(F_DATA_3.CNT_LINE,6)
VICTIM_PLAN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,11) = 'CORRELATION' &,
VICTIM_CORRID_FOUND = 'N' &,
SOURCE_CORRID_FOUND = 'N' THEN DO
EVENT_V_CORRID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,16)
VICTIM_CORRID_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,10) = 'CONNECTION' & ,
VICTIM_CONN_FOUND = 'N' & ,
SOURCE_CONN_FOUND = 'N' THEN DO
EVENT_V_CONNID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,15)
VICTIM_CONN_FOUND = 'Y'
END
IF F_DATA_1.CNT_LINE = 'ON' &,
F_DATA_2.CNT_LINE = 'MEMBER' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
CNT_LINE = CNT_LINE + 1
IF F_DATA_1.CNT_LINE <> 'DSNT501I' &,
F_DATA_1.CNT_LINE <> 'DSNT376I' THEN DO
TIMEOUT_OK = 'Y'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT501I' &,
TIMEOUT_OK = 'N' THEN DO
TIMEOUT_OK = 'Y'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT376I' THEN DO
TIMEOUT_OK = 'N'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT501I' &,
TIMEOUT_OK = 'Y' THEN DO
DO FOREVER
IF F_DATA_1.CNT_LINE = 'REASON' THEN DO
EVENT_REASON.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'TYPE' THEN DO
EVENT_O_TYPE.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'NAME' THEN DO
EVENT_O_NAME.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE,
F_DATA_3.CNT_LINE,
F_DATA_4.CNT_LINE
NAME_READ = 'Y'
END
IF NAME_READ = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
END
EVENT_SSID.CNT_OUTPUT = STRIP(EVENT_SSID.CNT_OUTPUT)
EVENT_DATE.CNT_OUTPUT = STRIP(EVENT_DATE.CNT_OUTPUT)
EVENT_TYPE.CNT_OUTPUT = STRIP(EVENT_TYPE.CNT_OUTPUT)
EVENT_V_PLAN.CNT_OUTPUT = STRIP(EVENT_V_PLAN.CNT_OUTPUT)
EVENT_V_CORRID.CNT_OUTPUT = STRIP(EVENT_V_CORRID.CNT_OUTPUT)
EVENT_V_CONNID.CNT_OUTPUT = STRIP(EVENT_V_CONNID.CNT_OUTPUT)
EVENT_S_PLAN.CNT_OUTPUT = STRIP(EVENT_S_PLAN.CNT_OUTPUT)
EVENT_S_CORRID.CNT_OUTPUT = STRIP(EVENT_S_CORRID.CNT_OUTPUT)
EVENT_S_CONNID.CNT_OUTPUT = STRIP(EVENT_S_CONNID.CNT_OUTPUT)
EVENT_REASON.CNT_OUTPUT = STRIP(EVENT_REASON.CNT_OUTPUT)
EVENT_O_TYPE.CNT_OUTPUT = STRIP(EVENT_O_TYPE.CNT_OUTPUT)
EVENT_O_NAME.CNT_OUTPUT = STRIP(EVENT_O_NAME.CNT_OUTPUT)
CNT_OUTPUT = CNT_OUTPUT + 1
VICTIM_PLAN_FOUND = 'N'
VICTIM_CORRID_FOUND = 'N'
VICTIM_CONN_FOUND = 'N'
SOURCE_PLAN_FOUND = 'N'
SOURCE_CORRID_FOUND = 'N'
SOURCE_CONN_FOUND = 'N'
NAME_READ = 'N'
END
END
SAY " "TIMEOUTS_READ" TIMEOUTS READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_TIMEOUT..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- DEADLOCKS AUS INPUT-DS LESEN --------------------*/
/*----------------------------------------------------------------*/
READ_DEADLOCK:
IF m.debug THEN SAY "ENTER PROCEDURE READ_DEADLOCK..."
DEADLOCKS_READ = 0
VICTIM_PLAN_FOUND = 'N'
VICTIM_CORRID_FOUND = 'N'
VICTIM_CONN_FOUND = 'N'
SOURCE_PLAN_FOUND = 'N'
SOURCE_CORRID_FOUND = 'N'
SOURCE_CONN_FOUND = 'N'
NAME_READ = 'N'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSNT375I' &,
CHECK_MAX_TST.CNT_LINE > m.lastDeadlock THEN DO
DEADLOCKS_READ = DEADLOCKS_READ + 1
EVENT_SSID.CNT_OUTPUT = F_SSID.CNT_LINE
EVENT_DATE.CNT_OUTPUT = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_TYPE.CNT_OUTPUT = 'D'
DO FOREVER
IF SUBSTR(F_DATA_4.CNT_LINE,1,4) = 'PLAN' &,
VICTIM_PLAN_FOUND = 'Y' &,
SOURCE_PLAN_FOUND = 'N' THEN DO
EVENT_S_PLAN.CNT_OUTPUT = ,
SUBSTR(F_DATA_4.CNT_LINE,6)
SOURCE_PLAN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,11) = 'CORRELATION' &,
VICTIM_CORRID_FOUND = 'Y' &,
SOURCE_CORRID_FOUND = 'N' THEN DO
EVENT_S_CORRID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,16)
SOURCE_CORRID_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,10) = 'CONNECTION' &,
VICTIM_CONN_FOUND = 'Y' &,
SOURCE_CONN_FOUND = 'N' THEN DO
EVENT_S_CONNID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,15)
SOURCE_CONN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_3.CNT_LINE,1,4) = 'PLAN' &,
VICTIM_PLAN_FOUND = 'N' &,
SOURCE_PLAN_FOUND = 'N' THEN DO
EVENT_V_PLAN.CNT_OUTPUT = ,
SUBSTR(F_DATA_3.CNT_LINE,6)
VICTIM_PLAN_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,11) = 'CORRELATION' &,
VICTIM_CORRID_FOUND = 'N' &,
SOURCE_CORRID_FOUND = 'N' THEN DO
EVENT_V_CORRID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,16)
VICTIM_CORRID_FOUND = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,10) = 'CONNECTION' & ,
VICTIM_CONN_FOUND = 'N' & ,
SOURCE_CONN_FOUND = 'N' THEN DO
EVENT_V_CONNID.CNT_OUTPUT = ,
SUBSTR(F_DATA_1.CNT_LINE,15)
VICTIM_CONN_FOUND = 'Y'
END
IF F_DATA_1.CNT_LINE = 'ON' &,
F_DATA_2.CNT_LINE = 'MEMBER' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
CNT_LINE = CNT_LINE + 1
IF F_DATA_1.CNT_LINE <> 'DSNT501I' &,
F_DATA_1.CNT_LINE <> 'DSNT375I' THEN DO
TIMEOUT_OK = 'Y'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT501I' &,
TIMEOUT_OK = 'N' THEN DO
TIMEOUT_OK = 'Y'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT375I' THEN DO
TIMEOUT_OK = 'N'
EVENT_REASON.CNT_OUTPUT = ' '
EVENT_O_TYPE.CNT_OUTPUT = ' '
EVENT_O_NAME.CNT_OUTPUT = ' '
CNT_LINE = CNT_LINE - 1
END
IF F_DATA_1.CNT_LINE = 'DSNT501I' &,
TIMEOUT_OK = 'Y' THEN DO
DO FOREVER
IF F_DATA_1.CNT_LINE = 'REASON' THEN DO
EVENT_REASON.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'TYPE' THEN DO
EVENT_O_TYPE.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'NAME' THEN DO
EVENT_O_NAME.CNT_OUTPUT = ,
F_DATA_2.CNT_LINE,
F_DATA_3.CNT_LINE,
F_DATA_4.CNT_LINE
NAME_READ = 'Y'
END
IF NAME_READ = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
END
EVENT_SSID.CNT_OUTPUT = STRIP(EVENT_SSID.CNT_OUTPUT)
EVENT_DATE.CNT_OUTPUT = STRIP(EVENT_DATE.CNT_OUTPUT)
EVENT_TYPE.CNT_OUTPUT = STRIP(EVENT_TYPE.CNT_OUTPUT)
EVENT_V_PLAN.CNT_OUTPUT = STRIP(EVENT_V_PLAN.CNT_OUTPUT)
EVENT_V_CORRID.CNT_OUTPUT = STRIP(EVENT_V_CORRID.CNT_OUTPUT)
EVENT_V_CONNID.CNT_OUTPUT = STRIP(EVENT_V_CONNID.CNT_OUTPUT)
EVENT_S_PLAN.CNT_OUTPUT = STRIP(EVENT_S_PLAN.CNT_OUTPUT)
EVENT_S_CORRID.CNT_OUTPUT = STRIP(EVENT_S_CORRID.CNT_OUTPUT)
EVENT_S_CONNID.CNT_OUTPUT = STRIP(EVENT_S_CONNID.CNT_OUTPUT)
EVENT_REASON.CNT_OUTPUT = STRIP(EVENT_REASON.CNT_OUTPUT)
EVENT_O_TYPE.CNT_OUTPUT = STRIP(EVENT_O_TYPE.CNT_OUTPUT)
EVENT_O_NAME.CNT_OUTPUT = STRIP(EVENT_O_NAME.CNT_OUTPUT)
CNT_OUTPUT = CNT_OUTPUT + 1
VICTIM_PLAN_FOUND = 'N'
VICTIM_CORRID_FOUND = 'N'
VICTIM_CONN_FOUND = 'N'
SOURCE_PLAN_FOUND = 'N'
SOURCE_CORRID_FOUND = 'N'
SOURCE_CONN_FOUND = 'N'
NAME_READ = 'N'
END
END
SAY " "DEADLOCKS_READ" DEADLOCKS READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_DEADLOCK..."
RETURN
/*----------------------------------------------------------------*/
/*---------- UNCOMMITED UOW AUS INPUT-DS LESEN -------------------*/
/*----------------------------------------------------------------*/
READ_UNCOMMITED_UOW:
IF m.debug THEN SAY "ENTER PROCEDURE READ_UNCOMMITED_UOW..."
UNCOMMITED_UOW_READ = 0
UOW_FINISHED = 'N'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSNJ031I' &,
CHECK_MAX_TST.CNT_LINE > SQL_MAX_TST_U THEN DO
UNCOMMITED_UOW_READ = UNCOMMITED_UOW_READ + 1
EVENT_UOW_SSID.CNT_OUTPUT_UOW = F_SSID.CNT_LINE
EVENT_UOW_DATE.CNT_OUTPUT_UOW = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_UOW_TYPE.CNT_OUTPUT_UOW = 'U'
DO FOREVER
IF F_DATA_1.CNT_LINE = 'HAS' &,
F_DATA_2.CNT_LINE = 'WRITTEN' THEN DO
EVENT_UOW_LOGREC.CNT_OUTPUT_UOW = ,
F_DATA_3.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CORRELATION' THEN DO
EVENT_UOW_CORRID.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CONNECTION' THEN DO
EVENT_UOW_CONNID.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'PLAN' THEN DO
EVENT_UOW_PLAN.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'AUTHID' THEN DO
EVENT_UOW_AUTHID.CNT_OUTPUT_UOW = ,
F_DATA_3.CNT_LINE
UOW_FINISHED = 'Y'
END
IF UOW_FINISHED = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
EVENT_UOW_SSID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_SSID.CNT_OUTPUT_UOW)
EVENT_UOW_DATE.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_DATE.CNT_OUTPUT_UOW)
EVENT_UOW_TYPE.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_TYPE.CNT_OUTPUT_UOW)
EVENT_UOW_LOGREC.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_LOGREC.CNT_OUTPUT_UOW)
EVENT_UOW_CORRID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_CORRID.CNT_OUTPUT_UOW)
EVENT_UOW_CONNID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_CONNID.CNT_OUTPUT_UOW)
EVENT_UOW_PLAN.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_PLAN.CNT_OUTPUT_UOW)
EVENT_UOW_AUTHID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_AUTHID.CNT_OUTPUT_UOW)
CNT_OUTPUT_UOW = CNT_OUTPUT_UOW + 1
UOW_FINISHED = 'N'
END
END
SAY " "UNCOMMITED_UOW_READ "UNCOMMITED UOW READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_UNCOMMITED_UOW..."
RETURN
/*----------------------------------------------------------------*/
/*------------- CHECKPOINTS AUS INPUT-DS LESEN -------------------*/
/*----------------------------------------------------------------*/
READ_CHECKPOINT:
IF m.debug THEN SAY "ENTER PROCEDURE READ_CHECKPOINT..."
CHECKPOINTS_READ = 0
UOW_FINISHED = 'N'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSNR035I' &,
CHECK_MAX_TST.CNT_LINE > SQL_MAX_TST_C THEN DO
CHECKPOINTS_READ = CHECKPOINTS_READ + 1
EVENT_UOW_SSID.CNT_OUTPUT_UOW = F_SSID.CNT_LINE
EVENT_UOW_DATE.CNT_OUTPUT_UOW = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_UOW_TYPE.CNT_OUTPUT_UOW = 'C'
DO FOREVER
IF F_DATA_1.CNT_LINE = 'AFTER' &,
F_DATA_3.CNT_LINE = 'CHECKPOINTS' THEN DO
EVENT_UOW_LOGREC.CNT_OUTPUT_UOW = ,
F_DATA_2.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CORRELATION' THEN DO
EVENT_UOW_CORRID.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CONNECTION' THEN DO
EVENT_UOW_CONNID.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'PLAN' THEN DO
EVENT_UOW_PLAN.CNT_OUTPUT_UOW = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'AUTHID' THEN DO
EVENT_UOW_AUTHID.CNT_OUTPUT_UOW = ,
F_DATA_3.CNT_LINE
UOW_FINISHED = 'Y'
END
IF UOW_FINISHED = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
EVENT_UOW_SSID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_SSID.CNT_OUTPUT_UOW)
EVENT_UOW_DATE.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_DATE.CNT_OUTPUT_UOW)
EVENT_UOW_TYPE.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_TYPE.CNT_OUTPUT_UOW)
EVENT_UOW_LOGREC.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_LOGREC.CNT_OUTPUT_UOW)
EVENT_UOW_CORRID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_CORRID.CNT_OUTPUT_UOW)
EVENT_UOW_CONNID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_CONNID.CNT_OUTPUT_UOW)
EVENT_UOW_PLAN.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_PLAN.CNT_OUTPUT_UOW)
EVENT_UOW_AUTHID.CNT_OUTPUT_UOW = STRIP(EVENT_UOW_AUTHID.CNT_OUTPUT_UOW)
CNT_OUTPUT_UOW = CNT_OUTPUT_UOW + 1
UOW_FINISHED = 'N'
END
END
SAY " "CHECKPOINTS_READ "CHECKPOINTS READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_CHECKPOINT..."
RETURN
/*----------------------------------------------------------------*/
/*---------- LOCK ESCALATIONS AUS INPUT-DS LESEN -----------------*/
/*----------------------------------------------------------------*/
READ_LOCKESCALATION:
IF m.debug THEN SAY "ENTER PROCEDURE READ_LOCKESCALATION..."
LOCKESCALATION_READ = 0
LES_FINISHED = 'N'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSNI031I' &,
CHECK_MAX_TST.CNT_LINE > SQL_MAX_TST_E THEN DO
LOCKESCALATION_READ = LOCKESCALATION_READ + 1
EVENT_LES_SSID.CNT_OUTPUT_LES = F_SSID.CNT_LINE
EVENT_LES_DATE.CNT_OUTPUT_LES = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_LES_TYPE.CNT_OUTPUT_LES = 'E'
DO FOREVER
IF F_DATA_1.CNT_LINE = 'RESOURCE' THEN DO
EVENT_LES_RESOURCE.CNT_OUTPUT_LES = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'LOCK' THEN DO
EVENT_LES_LOCKSTATE.CNT_OUTPUT_LES = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'PLAN' THEN DO
EVENT_LES_PLAN.CNT_OUTPUT_LES = ,
F_DATA_7.CNT_LINE
END
IF F_DATA_4.CNT_LINE = 'PACKAGE' THEN DO
EVENT_LES_PACKAGE.CNT_OUTPUT_LES = ,
F_DATA_9.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'COLLECTION-ID' THEN DO
EVENT_LES_COLLID.CNT_OUTPUT_LES = ,
F_DATA_3.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'STATEMENT' THEN DO
EVENT_LES_STATEMENT.CNT_OUTPUT_LES = ,
F_DATA_4.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CORRELATION-ID' THEN DO
EVENT_LES_CORRID.CNT_OUTPUT_LES = ,
F_DATA_3.CNT_LINE
END
IF F_DATA_1.CNT_LINE = 'CONNECTION-ID' THEN DO
EVENT_LES_CONNID.CNT_OUTPUT_LES = ,
F_DATA_3.CNT_LINE
LES_FINISHED = 'Y'
END
IF LES_FINISHED = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
EVENT_LES_SSID.CNT_OUTPUT_LES = STRIP(EVENT_LES_SSID.CNT_OUTPUT_LES)
EVENT_LES_DATE.CNT_OUTPUT_LES = STRIP(EVENT_LES_DATE.CNT_OUTPUT_LES)
EVENT_LES_TYPE.CNT_OUTPUT_LES = STRIP(EVENT_LES_TYPE.CNT_OUTPUT_LES)
EVENT_LES_PLAN.CNT_OUTPUT_LES = STRIP(EVENT_LES_PLAN.CNT_OUTPUT_LES)
EVENT_LES_PACKAGE.CNT_OUTPUT_LES = ,
STRIP(EVENT_LES_PACKAGE.CNT_OUTPUT_LES)
EVENT_LES_COLLID.CNT_OUTPUT_LES = STRIP(EVENT_LES_COLLID.CNT_OUTPUT_LES)
EVENT_LES_CORRID.CNT_OUTPUT_LES = STRIP(EVENT_LES_CORRID.CNT_OUTPUT_LES)
EVENT_LES_CONNID.CNT_OUTPUT_LES = STRIP(EVENT_LES_CONNID.CNT_OUTPUT_LES)
EVENT_LES_RESOURCE.CNT_OUTPUT_LES = ,
STRIP(EVENT_LES_RESOURCE.CNT_OUTPUT_LES)
EVENT_LES_LOCKSTATE.CNT_OUTPUT_LES = ,
STRIP(EVENT_LES_LOCKSTATE.CNT_OUTPUT_LES)
EVENT_LES_STATEMENT.CNT_OUTPUT_LES = ,
STRIP(EVENT_LES_STATEMENT.CNT_OUTPUT_LES)
CNT_OUTPUT_LES = CNT_OUTPUT_LES + 1
LES_FINISHED = 'N'
END
END
SAY " "LOCKESCALATION_READ "LOCK ESCALATION READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_LOCKESCALATION..."
RETURN
/*----------------------------------------------------------------*/
/*------------- ABNORMAL EOT AUS INPUT-DS LESEN-------------------*/
/*----------------------------------------------------------------*/
READ_EOT:
IF m.debug THEN SAY "ENTER PROCEDURE READ_EOT..."
EOT_READ = 0
EOT_FINISHED = 'N'
DO CNT_LINE = 1 TO ANZ_DDIN1
IF F_DATA_1.CNT_LINE = 'DSN3201I' &,
CHECK_MAX_TST.CNT_LINE > SQL_MAX_TST_A THEN DO
EOT_READ = EOT_READ + 1
EVENT_EOT_SSID.CNT_OUTPUT_EOT = F_SSID.CNT_LINE
EVENT_EOT_DATE.CNT_OUTPUT_EOT = F_DATE.CNT_LINE||,
'-'||,
SUBSTR(F_TIME.CNT_LINE,1,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,4,2)||,
'.'||,
SUBSTR(F_TIME.CNT_LINE,7,2)||,
'.000000'
EVENT_EOT_TYPE.CNT_OUTPUT_EOT = 'A'
DO FOREVER
IF SUBSTR(F_DATA_8.CNT_LINE,1,5) = 'USER=' THEN DO
EVENT_EOT_USER.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_9.CNT_LINE,6)
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,10) = 'CONNECTION' &,
SUBSTR(F_DATA_2.CNT_LINE,1,11) = 'CORRELATION' &,
SUBSTR(F_DATA_3.CNT_LINE,1,7) = 'JOBNAME' THEN DO
EVENT_EOT_CONNID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_1.CNT_LINE,15)
EVENT_EOT_CORRID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_2.CNT_LINE,16)
EVENT_EOT_JOBNAME.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_3.CNT_LINE,9)
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,5) = 'USER=' &,
SUBSTR(F_DATA_2.CNT_LINE,1,10) = 'CONNECTION' &,
SUBSTR(F_DATA_3.CNT_LINE,1,11) = 'CORRELATION' THEN DO
EVENT_EOT_USER.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_1.CNT_LINE,6)
EVENT_EOT_CONNID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_2.CNT_LINE,15)
EVENT_EOT_CORRID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_3.CNT_LINE,16)
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,5) = 'USER=' &,
SUBSTR(F_DATA_2.CNT_LINE,1,10) = 'CONNECTION' &,
SUBSTR(F_DATA_3.CNT_LINE,1,11) = 'CORRELATION' &,
SUBSTR(F_DATA_4.CNT_LINE,1,7) = 'JOBNAME' THEN DO
EVENT_EOT_USER.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_1.CNT_LINE,6)
EVENT_EOT_CONNID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_2.CNT_LINE,15)
EVENT_EOT_CORRID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_3.CNT_LINE,16)
EVENT_EOT_JOBNAME.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_4.CNT_LINE,9)
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,7) = 'JOBNAME' &,
SUBSTR(F_DATA_2.CNT_LINE,1,4) = 'ASID' &,
SUBSTR(F_DATA_3.CNT_LINE,1,3) = 'TCB' THEN DO
EVENT_EOT_JOBNAME.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_1.CNT_LINE,9)
EVENT_EOT_ASID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_2.CNT_LINE,6)
EVENT_EOT_TCB.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_3.CNT_LINE,5)
EOT_FINISHED = 'Y'
END
IF SUBSTR(F_DATA_1.CNT_LINE,1,4) = 'ASID' &,
SUBSTR(F_DATA_2.CNT_LINE,1,3) = 'TCB' THEN DO
EVENT_EOT_ASID.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_1.CNT_LINE,6)
EVENT_EOT_TCB.CNT_OUTPUT_EOT = ,
SUBSTR(F_DATA_2.CNT_LINE,5)
EOT_FINISHED = 'Y'
END
IF EOT_FINISHED = 'Y' |,
CNT_LINE > ANZ_DDIN1 THEN LEAVE
ELSE CNT_LINE = CNT_LINE + 1
END
EVENT_EOT_SSID.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_SSID.CNT_OUTPUT_EOT)
EVENT_EOT_DATE.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_DATE.CNT_OUTPUT_EOT)
EVENT_EOT_TYPE.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_TYPE.CNT_OUTPUT_EOT)
EVENT_EOT_USER.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_USER.CNT_OUTPUT_EOT)
EVENT_EOT_CONNID.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_CONNID.CNT_OUTPUT_EOT)
EVENT_EOT_CORRID.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_CORRID.CNT_OUTPUT_EOT)
EVENT_EOT_JOBNAME.CNT_OUTPUT_EOT=STRIP(EVENT_EOT_JOBNAME.CNT_OUTPUT_EOT)
EVENT_EOT_ASID.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_ASID.CNT_OUTPUT_EOT)
EVENT_EOT_TCB.CNT_OUTPUT_EOT =STRIP(EVENT_EOT_TCB.CNT_OUTPUT_EOT)
CNT_OUTPUT_EOT = CNT_OUTPUT_EOT + 1
EOT_FINISHED = 'N'
END
END
SAY " "EOT_READ "ABNORMAL EOT READ FROM MSTRLOG FILE"
IF m.debug THEN SAY "LEAVE PROCEDURE READ_EOT..."
RETURN
/*----------------------------------------------------------------*/
/*--------------- INSERT IN DB2 TABELLE TADM60A1 -----------------*/
/*----------------------------------------------------------------*/
INSERT_TADM60A1: procedure expose m.
IF m.debug THEN SAY "ENTER PROCEDURE INSERT_TADM60A1..."
cIns = 0
cDead = 0
cTime = 0
say ' ' time() 'begin insert into tadm60a1'
call sqlPrepare 7,
, "INSERT INTO "m.tadmCreator".TADM60A1 (" ,
"TIMESTAMP, ssid, event_type," ,
"VICTIM_PLAN, VICTIM_CORR_ID, VICTIM_COnn_ID," ,
"SOURCE_PLAN, SOURCE_CORR_ID, SOURCE_COnn_ID," ,
"REASON_CODE, type, name )" ,
"VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
do tx=1 to m.to.0
call sqlRxExecute 7,
, m.to.tx.tst, m.to.tx.v.dbMb, m.to.tx.evTy,
, m.to.tx.v.plan, left(m.to.tx.v.corr, 18), left(m.to.tx.v.conn, 18),
, m.to.tx.h.plan, left(m.to.tx.h.corr, 18), left(m.to.tx.h.conn, 18),
, m.to.tx.reason, m.to.tx.type, m.to.tx.name
cIns = cIns + 1
cDead = cDead + (m.to.tx.evTy == 'D')
cTime = cTime + (m.to.tx.evTy == 'T')
end
say ' ' time() cIns 'inserted into tadm60a1,' ,
cDead 'deadlocks and' cTime 'timeouts'
IF m.debug THEN SAY "LEAVE PROCEDURE INSERT_TADM60A1..."
RETURN;
/*----------------------------------------------------------------*/
/*--------------- INSERT IN DB2 TABELLE TADM63A1 -----------------*/
/*----------------------------------------------------------------*/
INSERT_TADM63A1:
IF m.debug THEN SAY "ENTER PROCEDURE INSERT_TADM63A1..."
OUTPUT_COUNT_UOW = 1
REC_INSERTED_UOW = 0
DO WHILE OUTPUT_COUNT_UOW < CNT_OUTPUT_UOW
REC_INSERTED_UOW = REC_INSERTED_UOW + 1
INSERT= "INSERT INTO "m.tadmCreator".TADM63A1 (" ,
"TIMESTAMP ," ,
"SSID ," ,
"EVENT_TYPE ," ,
"PLAN_NAME ," ,
"CORRID_ID ," ,
"CONN_ID ," ,
"AUTHID ," ,
"LOGREC )" ,
"VALUES ('"EVENT_UOW_DATE.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_SSID.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_TYPE.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_PLAN.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_CORRID.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_CONNID.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_AUTHID.OUTPUT_COUNT_UOW "'" ,
" ,'"EVENT_UOW_LOGREC.OUTPUT_COUNT_UOW "'" ,
" )"
SQLTEXT = INSERT
ADDRESS DSNREXX "EXECSQL DECLARE C8 CURSOR FOR S8"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S8 FROM :INSERT"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL EXECUTE S8"
IF SQLCODE <> 0 THEN CALL SQLCA
OUTPUT_COUNT_UOW = OUTPUT_COUNT_UOW + 1
END
SAY " "REC_INSERTED_UOW "RECORDS INSERTED INTO TADM63A1"
IF m.debug THEN SAY "LEAVE PROCEDURE INSERT_TADM63A1..."
RETURN;
/*----------------------------------------------------------------*/
/*--------------- INSERT IN DB2 TABELLE TADM64A1 -----------------*/
/*----------------------------------------------------------------*/
INSERT_TADM64A1:
IF m.debug THEN SAY "ENTER PROCEDURE INSERT_TADM64A1..."
OUTPUT_COUNT_LES = 1
REC_INSERTED_LES = 0
DO WHILE OUTPUT_COUNT_LES < CNT_OUTPUT_LES
REC_INSERTED_LES = REC_INSERTED_LES + 1
INSERT= "INSERT INTO "m.tadmCreator".TADM64A1 (" ,
"TIMESTAMP ," ,
"SSID ," ,
"EVENT_TYPE ," ,
"PLAN_NAME ," ,
"PACKAGE_NAME ," ,
"COLLECTION_ID ," ,
"CORRID_ID ," ,
"CONN_ID ," ,
"RESOURCE ," ,
"LOCK_STATE ," ,
"STATEMENT )" ,
"VALUES ('"EVENT_LES_DATE.OUTPUT_COUNT_LES "'" ,
" ,'"EVENT_LES_SSID.OUTPUT_COUNT_LES "'" ,
" ,'"EVENT_LES_TYPE.OUTPUT_COUNT_LES "'" ,
" ,'"EVENT_LES_PLAN.OUTPUT_COUNT_LES "'" ,
"," quo18(EVENT_LES_PACKAGE.OUTPUT_COUNT_LES) ,
"," quo18(EVENT_LES_COLLID.OUTPUT_COUNT_LES) ,
"," quo18(EVENT_LES_CORRID.OUTPUT_COUNT_LES) ,
"," quo18(EVENT_LES_CONNID.OUTPUT_COUNT_LES) ,
" ,'"EVENT_LES_RESOURCE.OUTPUT_COUNT_LES "'" ,
" ,'"EVENT_LES_LOCKSTATE.OUTPUT_COUNT_LES "'" ,
" ,'"EVENT_LES_STATEMENT.OUTPUT_COUNT_LES "'" ,
" )"
SQLTEXT = INSERT
ADDRESS DSNREXX "EXECSQL DECLARE C11 CURSOR FOR S11"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S11 FROM :INSERT"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL EXECUTE S11"
IF SQLCODE <> 0 THEN CALL SQLCA
OUTPUT_COUNT_LES = OUTPUT_COUNT_LES + 1
END
SAY " "REC_INSERTED_LES "RECORDS INSERTED INTO TADM64A1"
IF m.debug THEN SAY "LEAVE PROCEDURE INSERT_TADM64A1..."
RETURN;
/*----------------------------------------------------------------*/
/*--------------- INSERT IN DB2 TABELLE TADM65A1 -----------------*/
/*----------------------------------------------------------------*/
INSERT_TADM65A1:
IF m.debug THEN SAY "ENTER PROCEDURE INSERT_TADM65A1..."
OUTPUT_COUNT_EOT = 1
REC_INSERTED_EOT = 0
DO WHILE OUTPUT_COUNT_EOT < CNT_OUTPUT_EOT
REC_INSERTED_EOT = REC_INSERTED_EOT + 1
INSERT= "INSERT INTO "m.tadmCreator".TADM65A1 (" ,
"TIMESTAMP ," ,
"SSID ," ,
"EVENT_TYPE ," ,
"CORRID_ID ," ,
"JOBNAME ," ,
"CONN_ID ," ,
"AUTHID ," ,
"ASID ," ,
"TCB )" ,
"VALUES ('"EVENT_EOT_DATE.OUTPUT_COUNT_EOT "'" ,
" ,'"EVENT_EOT_SSID.OUTPUT_COUNT_EOT "'" ,
" ,'"EVENT_EOT_TYPE.OUTPUT_COUNT_EOT "'" ,
"," quo18(EVENT_EOT_CORRID.OUTPUT_COUNT_EOT) ,
"," quo18(EVENT_EOT_JOBNAME.OUTPUT_COUNT_EOT) ,
"," quo18(EVENT_EOT_CONNID.OUTPUT_COUNT_EOT) ,
" ,'"EVENT_EOT_USER.OUTPUT_COUNT_EOT "'" ,
" ,'"EVENT_EOT_ASID.OUTPUT_COUNT_EOT "'" ,
" ,'"EVENT_EOT_TCB.OUTPUT_COUNT_EOT "'" ,
" )"
SQLTEXT = INSERT
ADDRESS DSNREXX "EXECSQL DECLARE C13 CURSOR FOR S13"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S13 FROM :INSERT"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL EXECUTE S13"
IF SQLCODE <> 0 THEN CALL SQLCA
OUTPUT_COUNT_EOT = OUTPUT_COUNT_EOT + 1
END
SAY " "REC_INSERTED_EOT "RECORDS INSERTED INTO TADM65A1"
IF m.debug THEN SAY "LEAVE PROCEDURE INSERT_TADM65A1..."
RETURN;
/*----------------------------------------------------------------*/
/*--- 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
/*-- quote text t with apostrophs (sql string)
truncate if longer then 18 characters ---------------------------*/
quo18: procedure expose m.
parse arg t
if length(t) <= 18 then
return quote(t)
else
return quote(left(t, 17)"*")
endProcedur quo18
/*----------------------------------------------------------------*/
/*--------------- ZUWEISUNG EINES SPRECHENDEN TYPES --------------*/
/*----------------------------------------------------------------*/
ZUWEISUNG_TYPE:
IF m.debug THEN SAY "ENTER PROCEDURE ZUWEISUNG_TYPE..."
DO ZUWEISUNG_COUNT = 1 TO CNT_OUTPUT
SELECT
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000100' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'DB'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000200' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000201' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX-SPACE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000202' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000210' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'PARTITION'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000220' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'DATASET'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000230' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TEMP FILE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000300' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'PAGE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000301' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX-MINIPAGE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000302' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS-PAGE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000303' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX-PAGE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000304' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS-RID'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000D01' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'DBID/OBID'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000800' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'PLAN'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00000801' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'PACKAGE'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002000' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS CS-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002001' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS RR-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002002' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS WRITE-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002003' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX CS-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002004' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX RR-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002005' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX WRITE-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002006' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS PART CS-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002007' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS PART RR-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002008' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'TS PART WRITE-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002009' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX PART CS-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002010' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX PART RR-CLAIM CLASS'
WHEN EVENT_O_TYPE.ZUWEISUNG_COUNT = '00002011' THEN
EVENT_O_TYPE.ZUWEISUNG_COUNT = 'IX PART WRITE-CLAIM CLASS'
OTHERWISE NOP
END
END
IF m.debug THEN SAY "LEAVE PROCEDURE ZUWEISUNG_TYPE..."
RETURN
/*----------------------------------------------------------------*/
/*-------------- DBID UND OBID SELEKTIEREN -----------------------*/
/*----------------------------------------------------------------*/
SELECT_DBID_OBID:
IF m.debug THEN SAY "ENTER PROCEDURE SELECT_DBID_OBID..."
/*CONNECT TO DB2 SUBSYSTEM*/
call connect_subsys ssid
SAY " DBID / OBID CONVERSION..."
DO DBIDOBID_COUNT = 1 TO CNT_OUTPUT
SQL_DBID_OBID = ''
PARSE VAR EVENT_O_NAME.DBIDOBID_COUNT 1 SQL_DBID 9 SQL_DOT 10 SQL_OBID D
SQL_DBID = STRIP(SQL_DBID,L,0)
SQL_OBID = STRIP(SQL_OBID,L,0)
IF m.debug THEN SAY "DBID =" SQL_DBID
IF m.debug THEN SAY "OBID =" SQL_OBID
IF EVENT_O_TYPE.DBIDOBID_COUNT = 'DBID/OBID' THEN DO
/*GO AND CHECK THE SYSIBM.SYSTABLE*/
SQL_TB= "SELECT ",
" STRIP(CREATOR,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSTABLES ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_TB
ADDRESS DSNREXX "EXECSQL DECLARE C4 CURSOR FOR S4"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S4 FROM :SQL_TB"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C4"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C4 INTO :SQL_DBID_OBID :SQL_IND"
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C4"
/*IF NOT FOUND GO AND CHECK THE SYSIBM.SYSTABLESPACE*/
IF SQLCODE = 100 THEN DO
SQL_TS= "SELECT ",
" STRIP(DBNAME,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSTABLESPACE ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_TS
ADDRESS DSNREXX "EXECSQL DECLARE C5 CURSOR FOR S5"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S5 FROM :SQL_TS"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C5"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C5 INTO :SQL_DBID_OBID :SQL_IND"
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C5"
END
/*IF NOT FOUND GO AND CHECK THE SYSIBM.INDEXES*/
IF SQLCODE = 100 THEN DO
SQL_IX= "SELECT ",
" STRIP(CREATOR,B)!!'.'!!STRIP(NAME,B) ",
" FROM SYSIBM.SYSINDEXES ",
" WHERE DBID = " SQL_DBID ,
" AND OBID = " SQL_OBID ,
" WITH UR "
SQLTEXT = SQL_IX
ADDRESS DSNREXX "EXECSQL DECLARE C6 CURSOR FOR S6"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL PREPARE S6 FROM :SQL_IX"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL OPEN C6"
IF SQLCODE <> 0 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL FETCH C6 INTO :SQL_DBID_OBID :SQL_IND"
IF SQLCODE <> 0 & SQLCODE <> 100 THEN CALL SQLCA
ADDRESS DSNREXX "EXECSQL CLOSE C6"
END
SAY " " SQL_DBID_OBID,
"SELEKTIERT FÜR DBID" SQL_DBID ", OBID" SQL_OBID
EVENT_O_NAME.DBIDOBID_COUNT = SQL_DBID_OBID,
EVENT_O_NAME.DBIDOBID_COUNT
END
END
CALL DISCONNECT_SUBSYS
IF m.debug THEN SAY "LEAVE PROCEDURE SELECT_DBID_OBID..."
RETURN
/*----------------------------------------------------------------*/
/*--------------- ZUM DB2 SUBSYSTEM VERBINDEN --------------------*/
/*----------------------------------------------------------------*/
PREPARE_DSNREXX:
IF m.debug THEN SAY "ENTER PROCEDURE PREPARE_DSNREXX..."
ADDRESS TSO 'SUBCOM DSNREXX' /*HOST CMD ENV AVAILABLE*/
IF RC=1 THEN /*NO, LET'S MAKE ONE*/
S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /*ADD HOST CMD ENV*/
IF RC <> 0 & RC<> 1 THEN CALL SQLCA 'add DSNREXX'
IF m.debug THEN SAY "LEAVE PROCEDURE PREPARE_DSNREXX..."
RETURN
/*----------------------------------------------------------------*/
/*--------------- ZUM DB2 SUBSYSTEM VERBINDEN --------------------*/
/*----------------------------------------------------------------*/
CONNECT_SUBSYS:
PARSE arg conSSID
IF m.debug THEN SAY "ENTER PROCEDURE CONNECT_SUBSYS" conSSID
ADDRESS DSNREXX
"CONNECT" conSSID
IF SQLCODE <> 0 THEN CALL SQLCA 'connect' conSSID
SAY ""
SAY " CONNECTED TO" conSSID
SAY ""
IF m.debug THEN SAY "LEAVE PROCEDURE CONNECT_SUBSYS..."
RETURN
/*----------------------------------------------------------------*/
/*--------------- DISCONNECT DB2 SUBSYSTEM -----------------------*/
/*----------------------------------------------------------------*/
DISCONNECT_SUBSYS:
IF m.debug THEN SAY "ENTER PROCEDURE DISCONNECT_SUBSYS..."
ADDRESS DSNREXX
"DISCONNECT "
IF SQLCODE <> 0 THEN CALL SQLCA 'disconnect'
SAY ""
SAY " DISCONNECTED FROM DB2 SUBSYSTEM"
SAY ""
IF m.debug THEN SAY "LEAVE PROCEDURE DISCONNECT_SUBSYS..."
RETURN
/*----------------------------------------------------------------*/
/*--------- AUSGEBEN VON SQL-FEHLERBESCHREIBUNG SQLCA ------------*/
/*----------------------------------------------------------------*/
SQLCA:
IF m.debug THEN SAY "ENTER PROCEDURE SQLCA..."
parse ARG msg
ggSqlStmt = sqlText
call err msg sqlMsg()
say 'error ' msg
SAY 'SQLCODE =' SQLCODE 'rc=' rc
SAY 'SQLERRMC=' SQLERRMC
SAY 'SQLERRP =' SQLERRP
SAY 'SQLERRD =' SQLERRD.1',',
SQLERRD.2',',
SQLERRD.3',',
SQLERRD.4',',
SQLERRD.5',',
SQLERRD.6
SAY 'WQLWARN=' SQLWARN.0',',
SQLWARN.1',',
SQLWARN.2',',
SQLWARN.3',',
SQLWARN.4',',
SQLWARN.5',',
SQLWARN.6',',
SQLWARN.7',',
SQLWARN.8',',
SQLWARN.9',',
SQLWARN.10
SAY 'SQLSTATE=' SQLSTATE
SAY 'SQLTEXT =' SQLTEXT
IF m.debug THEN SAY "LEAVE PROCEDURE SQLCA..."
EXIT(8)
RETURN;
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
/*--- initialize sqlRx (belongs to sqlQ, but currently only one|) ----*/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sqlNull = '---'
m.sqlInd = 'sqlInd'
m.sqlRetOK.0 = 0
m.sqlCAMsg = 0
m.sqlSuMsg = 2
call sqlPushRetOk
m.sql.ini = 1
m.sql.conType = ''
m.sql.conSSID = ''
return 0
endProcedure sqlIni
/*--- connect and/or disconnect to DB2 -------------------------------*/
sqlConnect: procedure expose m.
parse upper arg sys, retOk
if sys \== '' then
nop
else if sysvar(sysnode) == 'RZ1' then
sys = 'DBAF'
else
call err 'no default subsys for' sysvar(sysnode)
call sqlOIni
hst = ''
if pos('/', sys) > 0 then do
parse value space(sys, 0) with hst '/' sys
cTy = 'Csm'
end
else do
cTy = 'Rx'
end
if m.sql.conType == cTy & m.sqlHost==hst & m.sqlConSSID == sys then
return 0
if m.sql.conType \== '' then
call sqlDisconnect
res = 0
if cTy = 'Rx' then
res = sqlRxConnect(sys, retOk)
if res < 0 then
return res
m.sql.conType = cTy
m.sql.conhost = hst
m.sql.conSSID = sys
m.sql.connection = oNew('Sql'cTy'Connection')
return res
endProcedure sqlConnect
sqlDisconnect: procedure expose m.
parse arg retOk
if m.sql.conType == 'Rx' then
call sqlRxDisconnect
m.sql.conType = ''
m.sql.conhost = ''
m.sql.conSSID = ''
return 0
endProcedure sqlDisonnect
/*--- execute a query from sql, with one resultset -------------------*/
sqlRxQuery: procedure expose m.
parse arg cx, src, retOk
m.sql.cx.updateCount = ''
m.sql.cx.resultSet = ''
m.sql.cx.needDesc = 1
res = sqlPrepare(cx, src, retOk, 1)
if res < 0 then
return res
res = sqlExec('declare c'cx 'cursor for s'cx, retOk)
if res < 0 then
return res
res = sqlExec('open c'cx, retOk)
if res < 0 then
return res
call sqlRxFetchVars cx
m.sql.cx.updateCount = sqlErrd.3
m.sql.cx.resultSet = cx
return res
endProcedure sqlRxQuery
/*--- fetch next row to m.dst.* at end return false ------------------*/
sqlRxFetch: procedure expose m.
parse arg cx, dst, retOk
if retOk == '' then
retOk = 100 m.sqlRetOk
fetCode = sqlExec('fetch c'cx 'into' sqlRxFetchVars(cx), retOk)
if fetCode == 100 then
return 0
if fetCode < 0 then
return fetCode
call sqlSetNull cx, dst
return 1
endProcedure sqlRxFetch
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlRxClose: procedure expose m.
parse arg cx, retOk
return sqlExec('close c'cx, retOk)
endProcedure sqlRxClose
/*-- execute an sql with no resultset, but possibly outParms ---------*/
sqlRxUpdate: procedure expose m.
parse arg cx, src, retOk
m.sql.cx.updateCount = ''
m.sql.cx.resultSet = ''
bx = verify(src, '( ')
if bx > 0 then
fun = translate(word(substr(src, bx), 1))
if fun = 'SET' then do
w2 = translate(word(substr(src, bx), 2))
if \ abbrev(w2, ':') then
return sqlExImm(src, retOk)
trace ?r
ex = pos('=', w2)
if ex = 0 then
ex = length(w2)+1
var = strip(substr(w2, 2, ex-2))
if var = '' then
call err 'bad hostVar in' src
m.sql.outVar = var
src2 = 'set :M.sql.out.'var substr(w, ex) subword(src, 3)
return sqlExec(src2, retOk)
end
if fun == 'DECLARE' then do
if 'GLOBAL' == translate(word(substr(src, bx), 2)) then
return sqlExImm(src, retOk)
end
res = sqlExec(src, retOk)
if wordPos(fun, 'DELETE INSERT UPDATE') > 0 then
m.sql.cx.updateCount = sqlErrd.3
return res
endProcedure sqlRxUpdate
/*-- execute a query, update or call ---------------------------------*/
sqlExecute: procedure expose m.
parse arg cx, src, retOk
src = inp2Str(src, '-sql')
f = translate(word(substr(src, max(verify(src, '( '), 1)), 1))
m.sql.cx.fun = f
if f == 'SELECT' | fun == 'WITH' then
return sqlQuery(cx, src, retOk)
else if f == 'CALL' then
call err 'implement sql call for:' src
else
return sqlUpdate(cx, src, retOk)
endProcedure sqlExecute
/*-- execute a query, copy result to stem ----------------------------*/
sql2St: procedure expose m.
parse arg src, dst, retOk, type
cx = sqlGetCursor()
res = sqlQuery(cx, src, retOk, type)
if res >= 0 then do
do sx=1 while sqlFetch(cx, dst'.'sx)
end
res = sx-1
end
m.dst.0 = res
call sqlClose cx
call sqlFreeCursor cx
return res
endProcedure sql2St
/*-- execute a query and return value of the first column
if > 1 row fail, if 0 rows return arg(3) or fail ----------*/
sql2One: procedure expose m.
parse arg src, dst
cx = sqlGetCursor()
call sqlQuery cx, src
if \ sqlFetch(cx, dst) then
if arg() > 2 then
return arg(3)
else
call err 'no row returned for:' src
if sqlFetch(cx, dst.2) then
call err '2 or more rows for' src
c1 = m.sql.cx.col.1
res = m.dst.c1
call sqlClose cx
call sqlFreeCursor cx
return res
endProcedure sql2One
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, ggRetOk, descOut
s = ''
src = inp2str(src, '%+Q\s')
m.sql.cx.d.sqlD = 'noSqlDA'
m.sql.cx.i.sqlD = 'noDescInp'
m.sql.cx.fetchVars = ''
m.sql.cx.col.0 = ''
m.sql.cx.into = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
return sqlExec('prepare s'cx s 'from :src', ggRetOk)
endProcedure sqlPrepare
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
if arg() <= 1 then
return sqlExec('open c'cx)
call sqlDescribeInput cx
do ix=1 to arg()-1
call sqlDASet cx , 'I', ix, arg(ix+1)
end
return sqlExec('open c'cx 'using descriptor :M.SQL.'cx'.I')
endProcedure sqlOpen
/*--- execute a prepared statement with arg(2), arg(3)... ------------*/
sqlRxExecute: procedure expose m.
parse arg cx retOk
if arg() <= 1 then
return sqlExec('execute s'cx, retOk)
call sqlDescribeInput cx
do ix=1 to arg()-1
call sqlDASet cx , 'I', ix, arg(ix+1)
end
return sqlExec('execute s'cx 'using descriptor :M.SQL.'cx'.I',
, retOk)
endProcedure
/*--- describe output (if not already done)
and return size of sqlDa ------------------------------------*/
sqlDescribeOutput: procedure expose m.
parse arg cx, force
if force == 1 | \ datatype(m.sql.cx.d.sqlD, 'n') then
call sqlExec 'describe s'cx 'into :M.SQL.'cx'.D', 0
return m.sql.cx.d.sqlD
endProcedure sqlDescribeOutput
/*--- describe input (if not already done)
and return size of input sqlDA ------------------------------*/
sqlDescribeInput: procedure expose m.
parse arg cx, force
if force == 1 | \ datatype(m.sql.cx.i.sqlD, 'n') then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
return m.sql.cx.i.sqlD
endProcedure sqlDescribeInput
/*--- put sqlNull in all vars where indicator says so ---------------*/
sqlSetNull: procedure expose m.
parse arg cx, dst
do nx=1 to m.sql.cx.sqlNull.0
col = m.sql.cx.sqlNull.nx
if m.dst.col.sqlInd < 0 then
m.dst.col = m.sqlNull
end
return
endProcedure sqlSetNull
/*--- use describe output to generate column names,
fetchVariables and sqlNull names ---------------------*/
sqlRxFetchVars: procedure expose m.
parse arg cx
if m.sql.cx.fetchVars \== '' then
return m.sql.cx.fetchVars
call sqlDescribeOutput cx
f = m.sql.cx.type
if f \== '' then do
f = f'.FLDS'
if m.f.0 < m.sql.cx.d.sqlD then
call err 'not enough column names'
end
m.sql.cx.col.0 = m.sql.cx.d.sqlD
nx = 0
vars = ''
do kx=1 to m.sql.cx.d.sqlD
cn = sqlVarName(f, kx, m.sql.cx.d.kx.sqlName)
m.sql.cx.col.kx = cn
vars = vars', :m.dst.'cn
if m.sql.cx.d.kx.sqlType // 2 = 1 then do
vars = vars' :m.dst.'cn'.sqlInd'
nx = nx + 1
m.sql.cx.sqlNull.nx = cn
end
end
m.sql.cx.sqlNull.0 = nx
m.sql.cx.fetchVars = substr(vars, 3)
return m.sql.cx.fetchVars
endProcedure sqlRxFetchVars
sqlVarName: procedure expose m. sqlVarName.
parse arg f, kx, sNa
if f == '' then do
cn = translate(word(sNa, 1))
if cn == '' | symbol('sqlVarName.cn') == 'VAR' then
cn = 'COL'kx
sqlVarName.cn = 1
return cn
end
else do
if m.f.kx == '' then
call err 'implement empty varName'
return substr(m.f.kx, 2)
end
endProcedure sqlVarName
/*--- set one value in a DA, handle nulls ----------------------------*/
sqlDASet: procedure expose m.
parse arg cx, da, ix, val
m.sql.cx.da.ix.sqlData = val
m.sql.cx.da.ix.sqlInd = - (val == m.sqlNull)
/* data types schienen einmal nicht zu funktionieren .......
if wordPos(m.da.ix.sqlType, '384 385 388 389 392 393') > 0 then
m.da.ix.sqlType = 448 + (m.da.ix.sqlType // 2) */
return
endProcedure sqlDASet
sqlExImm:
parse arg ggSrc, ggRetOk
return sqlExec('execute immediate :ggSrc', ggRetOk)
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRetOk
address dsnRexx 'execSql' ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
sqlHandleRCSqlCode:
if rc = 0 then
return 0
if ggRetOk = '' then
ggRetOk = m.sqlRetOk
if wordPos(rc, '1 -1') < 0 then
call err 'dsnRexx rc' rc sqlmsg()
else if pos('*', ggRetOk) > 0 | wordPos(sqlCode, ggRetOk) > 0 ,
then do
if sqlCode < 0 & pos('say', ggRetOk) > 0 then
say 'sqlError' sqlmsg()
return sqlCode
end
else if rc < 0 then
call err sqlmsg()
/*???lse if sqlCode <> 0 | (pos('w',ggRetOk)<1 & sqlWarn.0^==' ') then*/
else if (sqlCode <> 0 | sqlWarn.0^==' ') & pos('w',ggRetOk)<1 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem sys -----------------------------*/
sqlRxConnect: procedure expose m.
parse upper arg sys, ggRetOk
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 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
if sys = '-' then
return 0
m.sql.conSSID = sys
ggSqlStmt = 'connect' sys
address dsnRexx ggSqlStmt
return sqlHandleRcSqlCode()
endProcedure sqlRxConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlRxDisconnect: procedure expose m.
parse arg retOk
ggSqlStmt = 'disconnect'
m.sql.conSSID = ''
address dsnRexx ggSqlStmt
return sqlHandleRcSqlCode()
endProcedure sqlDisconnect
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/*--- push and pop currently accepted sqlCodes -----------------------*/
sqlPushRetOk: procedure expose m.
parse arg rr
nx = m.sqlRetOk.0 + 1
m.sqlRetOk.0 = nx
m.sqlRetOk.nx = rr
m.sqlRetOk = rr
return
endProcedure sqlPushRetOk
sqlPopRetOk: procedure expose m.
nx = m.sqlRetOk.0 - 1
if nx < 1 then
call err 'sqlPopRetOk with .0' m.sqlRetOk.0
m.sqlRetOk = m.sqlRetOk.nx
m.sqlRetOk.0 = nx
return
endProcedure sqlPopRetOk
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
if \ dataType(sqlCode, 'n') then do
ggRes = 'sqlCode' sqlCode 'not numeric\n'sqlCaMsg()
end
else do
ggRes = sqlDsntiar(sqlRx2CA())
ggWa = sqlMsgWarn()
if ggWa \= '' then
ggRes = ggRes'\nwarnings' ggWa
if m.sqlCAMsg == 1 then
ggRes = ggRes'\n'sqlCaMsg()'\n'sqlCaMsg(sqlCa2Rx(sqlCa))
end
ggSt = 'SQL.HOST'
ggVa = 'SQL.HOST.VAR'
ggBe = 'SQL.HOST.BEF'
call sqlHostVars ggSqlStmt, 12, ggSt
if datatype(sqlErrd.5, 'n') & sqlErrd.5 > 0 then do
ggW1 = translate(word(ggSqlStmt, 1))
ggW2 = translate(word(ggSqlStmt, 2))
if ggW1 == 'PREPARE' then
ggVV = sqlHostVarFind(ggSt, 'FROM')
else if ggW1 ggW2 == 'EXECUTE IMMEDIATE' then
ggVV = sqlHostVarFind(ggSt, 1)
else
ggVV = ''
if ggVV == '' then
ggRes = ggRes || sqlMsgSrcPos(ggSqlStmt, sqlErrd.5)
else
ggRes = ggRes || sqlMsgSrcPos(value(ggVV), sqlErrd.5)
end
ggRes = ggRes'\nstmt =' ggSqlStmt
ggPref = '\nwith'
do ggXX=1 to m.ggSt.0
ggRes = ggRes || ggPref m.ggBe.ggXX ':'m.ggVa.ggXX ,
'=' value(m.ggVa.ggXX)
ggPref = '\n '
end
if m.sqlSuMsg == 1 | (m.sqlSuMsg == 2 & m.sql.conHost \== '') then
ggRes = ggRes'\nsubsys =' ,
if(m.sql.conHost=='',,m.sql.conHost'/'),
|| m.sql.conSSID', interfaceType' m.sql.conType
return ggRes
endSubroutine sqlMsg
/*--- use dsnTiar to translate sql Info to error text ----------------*/
sqlDsnTiar: procedure expose m.
parse arg ca
if -438 = sqlCa2Rx(ca) then
return '\nSQLCODE = -438:',
'APPLICATION RAISED ERROR WITH sqlState' sqlState ,
'and DIAGNOSTIC TEXT:' sqlErrMc
liLe = 78
msLe = liLe * 10
msg = d2c(msLe,2) || left('', msLe)
len = d2c(liLe, 4)
ADDRESS LINKPGM "DSNTIAR ca msg len"
if rc <> 0 then
call err 'linkPgm dsnTiar rc' rc 'sqlCa' ca
res = strip(substr(msg, 13, liLe-10))
cx = pos(', ERROR: ', res)
if cx > 0 then
res = left(res, cx-1)':' strip(substr(res, cx+9))
do c=3+liLe by liLe to msLe while substr(msg, c, 10) = ''
res = res'\n 'strip(substr(msg, c+10, liLe-10))
end
return res
endProcedure sqlDsnTiar
/*--- format all rexx sqlCa fields into a message --------------------*/
sqlCaMsg:
return 'sqlCode' sqlCode 'sqlState='sqlState ,
'\n errMC='translate(sqlErrMc, ',', 'ff'x) ,
'\n warnings='sqlWarnCat('+') 'erP='sqlErrP ,
'\n errD.1='sqlErrD.1 '2='sqlErrD.2 '3='sqlErrD.3 ,
'\n errD.4='sqlErrD.4 '5='sqlErrD.5 '6='sqlErrD.6
endProcedure sqlCaMsg
/*--- format the sqlCA into the dsnTiar SQLCA ------------------------*/
sqlRx2Ca:
if \ (datatype(sqlcode, 'n') & datatype(sqlErrD.1, 'n') ,
& datatype(sqlErrD.3, 'n')) then
return err('sqlCode etc. not numeric\nsqlCa =' sqlCaMsg())
if digits() < 10 then
numeric digits 10
sqlCa = 'SQLCA ' || d2c(136, 4) || d2c(sqlCode, 4) ,
|| d2c(min(70, length(sqlErrMc)), 2)left(sqlErrMc, 70) ,
|| left(sqlErrP, 8) ,
|| d2c(sqlErrD.1, 4)d2c(sqlErrD.2, 4)d2c(sqlErrD.3, 4) ,
|| d2c(sqlErrD.4, 4)d2c(sqlErrD.5, 4)d2c(sqlErrD.6, 4) ,
|| sqlWarnCat() || sqlState
if length(sqlCa) <> 136 then
call err 'sqlCa length' length(sqlCa) 'not 136' ,
'\n'sqlCaMsg() '==>' ca', hex='c2x(ca)
return sqlCa
endProcedure sqlRx2Ca
/*--- extract the fields from the SqlCA and put it to rexx vars ------*/
sqlCA2Rx: procedure expose m. ,
sqlCode sqlErrMc sqlErrP sqlErrD. sqlWarn. sqlState
parse arg ca
numeric digits 10
if length(ca) < 136 | c2d(substr(ca, 9, 4), 4) <> 136 then
call err 'bad sqlCa len' length(ca) 'not 136:' ca', hex='c2x(ca)
sqlCode = c2d(substr(ca, 13 ,4), 4)
sqlErrMC = substr(ca, 19, c2d(substr(ca, 17, 2), 2))
sqlErrP = substr(ca, 89, 8)
do ix=1 to 6
sqlErrD.ix = c2d(substr(ca, 93 + 4 * ix, 4), 4)
end
do ix=0 to 10
sqlWarn.ix = substr(ca, 121 + ix, 1)
end
sqlState = substr(ca, 132, 5)
return sqlCode
endProcedure sqlCA2Rx
/*--- concat the sql warnings with Separator sep --------------------*/
sqlWarnCat: procedure expose m. sqlWarn.
parse arg sep
return sqlWarn.0 || sep,
|| sqlWarn.1||sqlWarn.2||sqlWarn.3||sqlWarn.4||sqlWarn.5||sep ,
|| sqlWarn.6||sqlWarn.7||sqlWarn.8||sqlWarn.9||sqlWarn.10||sep
endProcedure sqlWarnCat
/*--- make the text for sqlWarnings ----------------------------------*/
sqlMsgWarn: procedure expose m. sqlWarn.
r = ''
text =' 1=W var truncated, 1=S scrollable, 1=N nonScrollable,' ,
'2=W nulls in aggregate,' ,
'3=W more cols than vars,' ,
'3=Z more result sets than locators,' ,
'4=W no where, 4=D sensitive dynamic, 4=I insensitive,' ,
'4=S sensitive static,' ,
'5=W not valid sql, 5=1 readOnly, 5=2 readDelete,' ,
'5=3 readDeleteUpdate,' ,
'6=W day changed to month range,' ,
'7=W dec digits truncated,' ,
'8=W char substituted,' ,
'9=W arith excep in count, 9=Z multipe result sets,' ,
'10=W char conversion err in ca,'
do wx = 1 to 10
w = sqlWarn.wx
if w = ' ' then
iterate
t = wx'='w
cx = pos(' 'wx'='w' ', text)
ex = pos(',' , text, cx + 1)
if cx > 0 & ex > cx then
r = r substr(text, cx+1, ex-cx)
else
r = r wx'='w '?,'
end
r = strip(r, 't', ',')
if r = '' & sqlwarn.0 <> '' then
call err 'sqlWarn.0='sqlWarn.0 'but all warns empty'
return r
endProcedure sqlMsgWarn
/*--- show in the source src the point pos (where error occured)
a few lines from src around pos and arrow to pos ----------*/
sqlMsgSrcPos: procedure expose m.
parse arg src, pos
liLe = 68
liCn = 3
afLe = 25
t1 = space(left(src, pos), 1)
t2 = left(' ', substr(src, pos, 1) == ' ' ,
| substr(src, pos+1, 1) == ' ') ,
|| space(substr(src, pos+1), 1)
afLe = min(afLe, length(t2))
if length(t1) + afLe > liLe * liCn then
t1 = '...'right(t1, liLe * liCn - afLe -3)
else if length(t1)+length(t2) > liLe then
t1 = left(' ', (liCn * liLe - length(t1) -afLe) // liLe)||t1
pL = length(t1) // liLe
if length(t2) <= liLe-pL then
tx = t1 || t2
else
tx = t1 || left(t2, liLe-pL-3)'...'
res = '\nsrc' strip(substr(tx, 1, liLe), 't')
do cx=1+liLe by liLe to length(tx)
res = res || '\n +' strip(substr(tx, cx, liLe), 't')
end
loc = 'pos' pos 'of' length(src)
if length(loc)+6 < pL then
return res'\n >' right('>>>'loc'>>>', pL)
else
return res'\n >' left('', pL-1)'<<<'loc'<<<'
endProcdedure sqlMsgSrcPos
/*--- get the hostVars in the sql in src and the word before ---------*/
sqlHostVars: procedure expose m.
parse arg src, cnt, st
cx = 1
sx = 0
do cnt
cx = pos(':', src, cx) + 1
if cx < 2 then
leave
if pos(substr(src, cx, 1), m.mAlfRex1) < 1 then
iterate
ex = verify(src, m.mAlfRexR, 'n', cx)
if ex - cx > 100 then
iterate
sx = sx + 1
if ex < 1 then
m.st.var.sx = substr(src, cx)
else
m.st.var.sx = substr(src, cx, ex - cx)
/* search word before */
do bE = cx-2 by -1 to 1 ,
while substr(src, bE, 1) == ' '
end
do bB = bE by -1 to max(1, bE-20),
while pos(substr(src, bB, 1), m.mAlfa) > 0
end
if bB < bE & bB >= 0 then
m.st.bef.sx = substr(src, bB+1, bE-bB)
else
m.st.bef.sx = ''
end
m.st.0 = sx
return sx
endProcedure sqlHostVars
/*--- find the name of hostvar, by index or by before ----------------*/
sqlHostVarFind: procedure expose m.
parse arg st, fnd
if datatype(fnd, 'n') & fnd <= m.st.0 then
return m.st.var.fnd
do ix=1 to m.st.0
if translate(m.st.bef.ix) = fnd then
return m.st.var.ix
end
return ''
endSubroutine sqlHostVarFind
/* copy sql 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 expose m.
parse upper arg dsn ., addPrefix
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
sp = sysvar('SYSPREF')
if sp == '' then
sp = userid()
cx = pos('~', dsn)
if cx < 1 & addPrefix == 1 then
return sp'.'dsn
do while cx \== 0
le = left(dsn, cx-1)
ri = substr(dsn, cx+1)
if right(le, 1) == '.' | left(ri, 1) == '.' then
dsn = le || sp || ri
else
dsn = le || left('.', le \== '') || sp ,
|| left('.', ri \== '') || ri
cx = pos('~', spec, cx)
end
return dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
jcl2dsn: procedure expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
parse arg dsn, mbr
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
return dsn
endProcedure dsnSetMbr
dsnGetMbr: procedure expose m.
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))
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 expose m.
parse upper arg ggDD
call errAddCleanup 'call readDDEnd' ggDD', "*"'
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 expose m.
parse upper arg ggDD, ggRet
call errRmCleanup 'call readDDEnd' ggDD', "*"'
return adrTso('execio 0 diskr' ggDD '(finis)', ggRet)
endProcedure readDDEnd
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
parse upper arg ggDD
/* ensure file is erased, if no records are written */
call adrTso 'execio' 0 'diskw' ggDD '(open)'
call errAddCleanup 'call writeDDEnd' ggDD', "*"'
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 expose m.
parse upper arg ggDD, ggRet
call errRmCleanup 'call writeDDEnd' ggDD', "*"'
return adrTso('execio 0 diskw' ggDD '(finis)', ggRet)
endProcedure writeDDEnd
/*--- readNx: read next line, using buffer ---------------------------*/
/*--- begin: allocate dsnSpec and ini ------------------------ -------*/
readNxBegin: procedure expose m.
parse arg m, m.m.dsn, m.m.dd, m.m.Cnt
if m.m.dd = '' then
m.m.dd = 'DDNX'
if m.m.cnt = '' then
m.m.cnt = 1000
m.m.cx = m.m.cnt + 999
m.m.buf0x = 0
m.m.0 = 0
m.m.free = subword(dsnAlloc('dd('m.m.dd')' m.m.dsn), 2)
call readDDBegin m.m.dd
return m
endProcedure readDDNxBegin
/*--- return the stem of the next line, or '' at end -----------------*/
readNx: procedure expose m.
parse arg m
m.m.cx = m.m.cx + 1
if m.m.cx <= m.m.0 then
return m'.'m.m.cx
m.m.buf0x = m.m.buf0x + m.m.0
if \ readDD(m.m.dd, 'M.'m'.', m.m.cnt)then
return ''
m.m.cx = 1
return m'.1'
endProcedure readDDNx
/*--- return the stem of the curr line, '' at end --------------------*/
readNxCur: procedure expose m.
parse arg m
if m.m.cx <= m.m.0 then
return m'.'m.m.cx
else
return ''
endProcedure readNxCur
/*--- return the position (line number) of reader
plus le characters of the current line (default 50) ------*/
readnxPos: procedure expose m.
parse arg m, le
li = m'.'m.m.cx
li = strip(m.li, 't')
if arg() < 2 then
le = 50
if le < 1 then
li = ''
else if length(li) <= le then
li = ':' li
else
li = ':' left(li, le-3)'...'
return 'line' (m.m.buf0x + m.m.cx)li
endProcedure readnxPos
/*--- close and deallocate ------------------------------------------*/
readNxEnd: procedure expose m.
parse arg m
call readDDEnd m.m.dd
interpret m.m.free
return
endProcedure readDDNxEnd
/*--- standardise a dsn spec
word1 dsName or -
word2 dd or -
word3 disp or -
word4 to first : attributes in tso format
after first : attributes for new allocation
----------------------------------------------------------------------*/
dsnSpec: procedure expose m.
parse upper arg spec
rr = '' /* put leading - in separate words */
do sx=1 while words(rr) < 3 & wx \= ''
wx = word(spec, sx)
do while abbrev(wx, '-') & words(rr) < 3
wx = substr(wx, 2)
rr = rr '-'
end
rr = rr wx
end
spec = rr subWord(spec, sx)
na = ''
dd = ''
di = ''
if left(spec, 1) = '&' then /* external spec is handled ok */
spec = strip(substr(spec, 2))
do wx=1 by 1
w = word(spec, wx)
if w = '' | abbrev(w, '.') | abbrev(w, ':') then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
di = w
else if w = 'CATALOG' then
di = di w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if abbrev(w, 'DSN(') then
na = strip(substr(w, 5, length(w)-5))
else if na == '' then
na = dsn2jcl(w)
else if dd == '' then
dd = w
else if di == '' then
di = w
else
leave
end
if na == '' then
na = '-'
else if abbrev(na, "'") then
na = substr(na, 2, length(na)-2)
if dd == '' then dd = '-'
if di == '' then di = '-'
re = subword(spec, wx)
if abbrev(re, '.') then
re = substr(re, 2)
return na dd di re
endProcedure dsnSpec
/*--- alloc a dsn with dsnAlloc
if the dsn is inuse wait and retry
until either the allocation is successfull
or the timeout occurs --------------------------------------*/
dsnAllocWait: procedure expose m.
parse upper arg spec, pDi, pDD, timeOut
x = max(1, arg() - 1)
do rt=0
m.adrTsoAl.1 = ''
m.adrTsoAl.2 = ''
m.adrTsoAl.3 = ''
call outtrap m.adrTsoAl.
res = dsnAlloc(spec, pDi, pDD, '*')
call outtrap off
if \ abbrev(res, ' ') then
return res
msg = m.adrTsoAl.1'\n'm.adrTsoAl.2'\n'm.adrTsoAl.3
if rt > timeOut & timeOut \== '' then
return err('timeout allocating' spec time() '\n'msg)
if pos('DATA SET IS ALLOCATED TO ANOTHER', msg) < 1 then
return err('allocating' spec'\n'msg)
say time() 'sleep and retry alloc' spec
call sleep 1, 0
end
endProcedure dsnAllocWait
/*--- alloc a dsn or a dd
spec '-'<ddName>
datasetName? disposition? '.'? attributes? (':' newAtts)?
disp default disposition
dd default dd name
retRc erlaubte ReturnCodes (leer = 0)
returns if ok then ddName <rexx for free> otherwise rc -----*/
dsnAlloc: procedure expose m.
parse upper arg spec, pDi, pDD, retRc
parse value dsnSpec(spec) with na dd di rest
if na = '-' then
m.dsnAlloc.dsn = ''
else
m.dsnAlloc.dsn = na
if na == '-' & dd \== '-' & di == '-' & rest = '' then
return dd
if dd == '-' & pDD \== '' then
dd = pDD
if dd == '-' then do
if symbol('m.adrTso.ddNum') = 'VAR' then
dd = m.adrTso.ddNum + 1
else
dd = 1
m.adrTso.ddNum = dd
dd = 'DD' || dd
end
if di = '-' & pDi \== '' then
di = pDi
if di = '-' then
di = 'SHR'
else if pos('(', na) < 1 then
nop
else if di = 'MOD' then
call err 'disp mod for' na
else
di = 'SHR'
if pos('/', na) > 0 then
return csmAlloc(na dd di rest, retRc)
else
return tsoAlloc(na dd di rest, retRc)
endProcedure dsnAlloc
tsoAlloc: procedure expose m.
parse arg na dd disp rest ':' nn, retRc
c = 'alloc dd('dd')' disp
if na \== '-' then
c = c "DSN('"na"')"
else if disp = 'NEW' and nn \== '' then
c = c dsnCreateAtts(,nn)
call outtrap m.adrTsoAl.
alRc = adrTso(c rest, '*')
call outtrap off
if alRc = 0 then do
call errAddCleanup 'call tsoFree' dd', "*"'
return dd 'call tsoFree' dd';'
end
if nn \= '' & wordPos(disp, 'OLD SHR') > 0 ,
& sysDsn("'"m.dsnAlloc.dsn"'") == 'DATASET NOT FOUND' then do
say 'tsoAlloc creating' c rest ':'nn
call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(na, nn)
call adrTso 'free dd('dd')'
return tsoAlloc(na dd disp rest, retRc)
end
do ax=1 to m.adrTsoAl.0
say m.adrTsoal.ax
end
if retRc = '*' | wordPos(alRc, retRc) > 0 then
return ' ' alRc
call err 'tsoAlloc rc' alRc 'for' c rest
endProcedure tsoAlloc
tsoAtts: procedure expose m.
parse arg dsn
rc = listDsi("'"dsn"' SMSINFO")
if rc = 0 then
mv = ''
else if rc = 4 & sysReason = 19 then do
mv = 'UNITCNT(30)'
say 'multi volume' mv
end
else if rc ^= 0 then
call err 'listDsi rc' rc 'reason' sysReason,
sysMsgLvl1 sysMsgLvl2
al = 'CAT'
al = ''
if right(sysDsSms, 7) == 'LIBRARY' ,
| abbrev(sysDsSms, 'PDS') then
al = al 'DSNTYPE(LIBRARY)'
if sysUnits = 'TRACK' then
sysUnits = 'TRACKS'
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
"DATACLAS("sysDataClass")" ,
"RECFM("translate('1 2 3', ' 'sysREcFM, ' 123')")",
"LRECL("SYSLRECL")",
"blksize("sysBLkSIZE")",
"SPACE("sysPrimary"," sysSeconds")" sysUnits mv
return al
endProcedure tsoAtts
tsoFree: procedure expose m.
parse arg dd, ggRet
call adrTso 'free dd('dd')', ggRet
call errRmCleanup 'call tsoFree' dd', "*"'
return
endProcedure tsoFree
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
forCsm = forCsm == 1
aU = ' 'translate(atts)
if abbrev(atts, ':') then do
parse var atts a1 atts
bl = 32760
rl = substr(a1, 3)
if abbrev(a1, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(a1, 2, 1) 'b'
end
if forCsm then
atts = atts "recfm("space(recfm, 0)") lrecl("rl")",
"blkSize("bl")"
else
atts = atts "recfm("recfm") lrecl("rl") block("bl")"
end
if pos('(', dsn) > 0 & pos(' DSNTYPE(', aU) < 1 ,
& pos(' DSORG(', aU) < 1 then
atts = atts 'dsntype(library) dsorg(po)'
if pos(' MGMTCLAS(', aU) < 1 then
atts = atts 'mgmtclas(COM#A091)'
if pos(' SPACE(', aU) < 1 then
if forCsm then
atts = atts 'space(10, 1000) cylinder'
else
atts = atts 'space(10, 1000) cyl'
if dsn == '' then
return atts
return "dataset('"dsnSetMbr(dsn)"')" atts
endProcedure dsnCreateAtts
/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/
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
/*--- write the dataset specified in ggDsnSpec from stem ggSt
write ggCnt records if not empty otherwise ggst0
if ggSay 1 then say ... records written to ... -------------*/
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
if ggCnt == '' then
ggCnt = value(ggst'0')
ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
'(stem' ggSt 'open finis)'
interpret subword(ggAlloc, 2)
if ggSay == 1 | m.debug == 1 then
say ggCnt 'records written to' ggDsnSpec
return
endSubroutine writeDsn
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy ut begin *****************************************************/
/*--- if function warning all3 arguments get evaluated|
e.g if(x=0, 'infinity', 1/0) will fail| -----------*/
if: procedure expose m.
parse arg co, ifTrue, ifFalse
if co then
return ifTrue
else
return ifFalse
endProcedure if
/*--- embedded ASSignement:
assign the second argument to the variable with name in first arg
and return the value assigned ----------------------------------*/
ass:
call value arg(1), arg(2)
return arg(2)
/*--- embedded ASSignement only if NotNull:
assign the second argument to the variable with name in first arg
if the second arg is not null, return new value ---------------*/
assIf:
if arg(2) == '' then
return value(arg(1))
call value arg(1), arg(2)
return arg(2)
/*--- return first nonNull argument ---------------------------------*/
nn:
if arg(1) \== '' then
return arg(1)
if arg(2) \== '' then
return arg(2)
call err 'nn() both args empty'
/*--- embedded ASSignement return NotNull:
assign the second argument to the variable with name in first arg
and return 1 if value not null, 0 if null ----------------------*/
assNN:
call value arg(1), arg(2)
return arg(2) \== ''
/*--- return current time and cpu usage ------------------------------*/
timing: procedure expose m.
return return time() 'ela='time('E') 'cpu='sysvar('syscpu'),
'su='sysvar('syssrv')
timingTest: procedure expose m.
say 'begin' timing() sysvar('sysnode')
do 30000000
end
say 'end ' timing()
return
/*--- sleep several seconds ------------------------------------------*/
sleep: procedure expose m.
parse arg secs, sayIt
if sayit <> 0 then
say 'sleeping' secs 'secs' time()
CALL SYSCALLS 'ON'
ADDRESS SYSCALL "sleep" secs
CALL SYSCALLS 'OFF'
if sayit <> 0 then
say 'slept' secs 'secs' time()
return
endProcedure sleep
/*--- elongate inp with spaces up to given len -----------------------*/
elong: procedure expose m.
parse arg inp, len
if length(inp) >= len then
return inp
return left(inp, len)
endProcedure elong
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure expose m.
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 the count of occurrences of needle in heyStack ----------*/
posCount: procedure expose m.
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
repAll: procedure expose m.
parse arg src, w, new
res = ''
cx = 1
do forever
nx = pos(w, src, cx)
if nx < 1 then
return res || substr(src, cx)
res = res || substr(src, cx, nx-cx) || new
cx = nx + length(w)
end
endProcedure repAll
repAllWords: procedure expose m.
parse arg src, w, new
res = ''
wx = 0
cx = 1
do forever
wx = wordPos(w, src, wx+1)
if wx < 1 then
return res || substr(src, cx)
nx = wordindex(src, wx)
res = res || substr(src, cx, nx-cx) || new
cx = nx + length(w)
end
endProcedure repAllWords
/* copy ut end ********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
errIni: procedure expose m.
if m.err.ini == 1 then
return
call outIni
m.err.ini = 1
m.err.handler = ''
m.err.cleanup = ';'
m.err.opt = ''
return
endProcedure errIni
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
call errIni
parse arg m.err.opt, m.err.handler
if pos('I', translate(m.err.opt)) > 0 then
if errOS() \== 'LINUX' then
if sysVar('sysISPF') = 'ACTIVE' then
call adrIsp 'control errors return'
return
endSubroutine errReset
/*--- error routine: abend with message ------------------------------*/
err:
parse arg ggTxt, ggOpt
call errIni
drop err handler cleanup opt call return
if ggOpt == '' & m.err.handler \== '' then do
if 1 then do /* no detection of recursive err call loop
--> will anyway fail by stack overflow */
interpret m.err.handler
end
else do
/* avoid recursive err call loop */
drop call return
if symbol('m.err.call') \== 'VAR' then
m.err.call = 1
else
m.err.call = m.err.call + 1
if m.err.call > 10 then do
say 'errHandler loop:' m.err.handler
end
else do
m.err.return = 1
call errInterpret m.err.handler
m.err.call = m.err.call - 1
if m.err.return then
return result
end
end
end
call outDst
call errSay ggTxt, 'e'
call errCleanup
if ggOpt == '' then
ggOpt = m.err.opt
ggOpt = translate(ggOpt)
if pos('T', ggOpt) > 0 then do
trace ?r
say 'trace ?r in err'
end
if pos('H', ggOpt) > 0 then do
call errSay 'divide by zero to show stackHistory', 'e'
x = 1 / 0
end
call errSay 'exit(12)', 'e'
exit errSetRc(12)
endSubroutine err
/*--- error routine: user message cleanup exit -----------------------*/
errEx:
parse arg ggTxt
call errIni
call outDst
call errSay ggTxt
call errCleanup
exit 8
endProcedure errEx
errAddCleanup: procedure expose m.
parse arg code
if m.err.ini \== 1 then
call errIni
/* concatenate backwards, then it is executed also backwards */
m.err.cleanup = ';'code || m.err.cleanup
return
endProcedure errAddCleanup
errRmCleanup: procedure expose m.
parse arg code
if m.err.ini \== 1 then
call errIni
cx = pos(';'code';', m.err.cleanup)
if cx > 0 then
m.err.cleanup = left(m.err.cleanup, cx) ,
|| substr(m.err.cleanup, cx + length(code)+2)
return
endProcedure errRmCleanup
errCleanup: procedure expose m.
call errIni
cl = m.err.cleanup
if cl = ';' then
return
m.err.cleanup = ';'
say 'err cleanup begin' cl
call errInterpret cl
say 'err cleanup end' cl
return
endProcedure errCleanup
errInterpret: procedure expose m.
parse arg code
interpret code
m.err.return = 0
return
endProcedure errInterpret
/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
interpret 'assertRes =' arg(1)
if \ assertRes then
call err 'assert failed' arg(1)':' arg(2)
return
endProcedure assert
/*--- output an errorMessage msg with pref pref
split message in lines at '/n' ---------------------------*/
errSay: procedure expose m.
parse arg msg, pref
parse source . . ggS3 . /* current rexx */
if pref == 'e' then
msg = 'fatal error in' ggS3':' msg
else if pref == 'w' then
msg = 'warning in' ggS3':' msg
else if pref \== '' then
msg = pref':' msg
return outNl(msg)
endProcedure errSay
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, op
call errSay msg, 'e'
call help
call err msg, op
endProcedure errHelp
/*--- return the Operating System we are running on: TSO or LINUX ---*/
errOS: procedure expose m.
parse source os .
return os
endProcedure errOS
/*--- 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
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
if errOS() \== 'LINUX' then
if sysVar('sysISPF') = 'ACTIVE' then
address ispExec vput 'zIspfRc' shared
return zIspfRc
endProcedure errSetRc
/*--- output a trace message if m.tr is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
call out 'trc:' msg
return
endProcedure trc
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
call out 'debug' msg
return
endProcedure debug
/*--- display the first comment block of the source as help ----------*/
help: procedure expose m.
parse source . . s3 .
call out right(' help for rexx' s3, 79, '*')
do ax=1 to arg()
say ' ' arg(ax)
end
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
call out '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
call out li
end
call out right(' end help for rexx' s3, 79, '*')
return 4
endProcedure help
/*--- output all lines (separated by '\n') of all args --------------*/
outNl: procedure expose m.
do ax=1 to max(1, arg())
msg = arg(ax)
sx = 0
bx = -1
do lx=1 until bx >= length(msg)
ex = pos('\n', msg, bx+2)
if ex < 1 then
ex = length(msg)+1
call out substr(msg, bx+2, ex-bx-2)
bx = ex
end
end
return 0
endProcedure outNl
/* copy err end *****************************************************/
/* copy out begin ******************************************************
out interface simple with say only
***********************************************************************/
outIni: procedure expose m.
parse arg msg
return
endProcedure outIni
/*--- output a message to the current destination -------------------*/
out: procedure expose m.
parse arg msg
say msg
return 0
endProcedure out
/*--- set a new out destination and return old one ------------------*/
outDst: procedure expose m.
parse arg d
return ''
endProcedure outDst
/* return the contents of a string or std input */
inp2str: procedure expose m.
parse arg rdr, opt
return rdr
endProcedure inp2str
/* copy out end *****************************************************s