zOs/REXX.O13/ADRISPV
/* copy adrIsp begin *************************************************/
/**********************************************************************
lmd: catalog read
call sequence: lmdBegin, lmdNext*, lmdEnd
mit lmd service (mit save in file und read,
weil list zu langsam und listcat abstürzt)
1. arg (grp) als group dataset für lmd save
und dd name für file read
***********************************************************************/
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
res = adrIsp('lmdlist listid(&lmdId) option(save) group('grp')', 4)
call adrIsp 'lmdfree listid(&lmdId)'
if res = 0 then do
call trc showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt, withVolume
if ^ readDD(ggGrp, ggSt) then
return 0
if withVolume ^== 1 then
do ggIx=1 to value(ggSt'0')
x = value(ggSt || ggIx, word(value(ggSt || ggIx), 1))
end
return 1
endSubroutin lmdNext
lmdEnd: procedure
parse arg grp
call readDDEnd grp
call adrTso 'free dd('grp')'
return /* end lmdEnd */
/*--- make a readDescriptor for catlogsearch mask --------------------*/
LMDreader: procedure expose m.
parse arg mask
rx = wrNew()
gr = 'LMD'rx
call lmdBegin gr, mask
gr = quote(gr)
call reDefine rx, "res = lmdNext("gr", m.stem.)",
, "call lmdEnd("gr"); call wrFree" rx
return rx
endProcedure LMDreader
/*--- catalogSearch on mask and write it to std out ------------------*/
LMDout: procedure expose m.
parse arg mask
call outReader LMDreader(mask)
return
endProcedure LMDout
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsn
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
res = lmmId
if mbr <> '' then
res = res 'pattern('mbr')'
return res
endProcedure lmmBegin
lmmEnd: procedure
parse arg lmmId opt
call adrIsp "LMMLIST DATAID("lmmId") option(free)", 8
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
if adrIsp("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
return mbr
else
return ''
endProcedure lmmNext
/*--- define new reader for memberListSearch on dsn
member may be a membermask -------------------------------------*/
LMMreader: procedure expose m.
parse arg dsn
wx = wrNew()
res = quote(lmmBegin(dsn))
call reDefine wx, "m.stem.1 = lmmNext("res");" ,
"res = m.stem.1 ^== '';" ,
"m.stem.0 = res",
, "call lmmEnd("res"); call wrFree" wx
return wx
endProcedure LMMreader
/*--- write member list of dsn to std out ----------------------------*/
LMMout: procedure expose m.
parse arg dsn
call outReader LMMreader(dsn)
return
endProcedure LMMOut
/*--- write to std out all existing datasets and members
of a list. list looks like wk.*(e*) a.b.c
if member = '-' does not list members
if member contains a second word '-' seq DS are not listed
---------------------------------------------------------------------*/
lmx: procedure expose m.
parse arg list
px = piNew(2)
call piBegin px
call piDefine ,, "call lmdOut m.line"
call piBar
qx = m.wr.prc
call piDefine ,, "call lmxPds m.line, m."px".mbrOpt"
call piEnd px, 0
do wx=1 to words(list)
w = dsn2jcl(word(list, wx))
m.px.mbrOpt = dsnGetMbr(w)
pds = dsnSetMbr(w)
if verify(pds, '*%', 'm') < 1 then do
call writeLn qx, pds
end
else do
call writeLn px, pds
call write px
end
end
call wrClose px
call wrFree px, qx
call out
return
endProcedure lmx
lmxPds: procedure expose m.
parse arg pds, mbr noPds .
rc = listdsi("'"pds"' recall")
if rc ^= 0 then do
if rc = 16 & sysReason = 5 then
say "listDsi not catalogued '"pds"'"
else
call err 'listDsi nc' rc 'reason' sysReason SYSMSGLVL2,
"pds '"pds"'"
end
else if left(sysDsOrg, 2) ^== 'PO' then do
if noPds ^== '-' then
call outLn pds
end
else if mbr ^== '-' then do
rx = lmmReader("'"strip(pds)"("mbr")'")
cnt = 0
do while read(rx, 'ADRISP.LMX.'px)
do xx=1 to m.adrIsp.lmx.px.0
m.adrIsp.lmx.px.xx = dsnSetMbr(pds, m.adrIsp.lmx.px.xx)
end
call out 'ADRISP.LMX.'px
cnt = cnt + m.adrIsp.lmx.px.0
end
say cnt 'members in' strip(pds)'('mbr')'
end
return
endProcedure lmxPds
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSqlRc: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
if rc = 0 then
return 0 /* say "sql ok:" ggSqlStmt */
else if rc < 0 then
call err "sql rc" rc sqlmsg()
if sqlCode = 0 then
say 'warning' sqlMsg()
return sqlCode
endSubroutine adrSqlRc
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggNo
if adrSqlRc(ggSqlStmt, ggNo) = 0 then
return
call err "sql rc" rc sqlmsg()
endSubroutine adrSql
adrSqlConnect: procedure
parse arg sys
if adrTSORc("SUBCOM DSNREXX") <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" sys, 1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
call adrSql "disconnect ", 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x))':' ggSqlStmt
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTsoRc('DSN SYSTEM('sys')')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/**********************************************************************
adr*: address an environment
***********************************************************************/
adrIsp:
parse arg ggIspCmd, ggRet
address ispexec ggIspCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr ispExec rc' rc 'for' ggIspCmd
endSubroutine adrIsp
adrEdit:
parse arg ggEditCmd, ggRet
address isrEdit ggEditCmd
if rc = 0 then return 0
else if ggRet == '*' then return rc
else if wordPOS(rc, ggRet) > 0 then return rc
else
call err 'adr isrEdit rc' rc 'for' ggEditCmd
endSubroutine adrEdit
/* copy adrIsp end *************************************************/