zOs/REXX.O13/CDT
/* REXX *************************************************************
this editmacro replaces all #dt# by the current date time
**********************************************************************/
call adrEdit('macro (args)')
say 'macro args' args
tst = time('N')
tst = 'D'date('j')'.T'left(tst,2)substr(tst, 4, 2)right(tst,2)
say 'timestamp' tst
call adrEdit "c '#dt#' '"tst"' all"
exit 0
/************** member copy adr **************************************/
/**********************************************************************
dsn*: manipulate dataSetNames
dsn2Jcl: convert from tso to JCL format
dsnFromJcl: convert from jcl to TSO format
dsnGetLLQ: get the llq from a dsn
dsnGetMbr: get the Member name from a dsn
dsnApp: cleanup and append dsn parts (preserve apos ...)
dsnSetMbr: set a Member name or remove it if mbr = ''
***********************************************************************/
say dsnApp("a.b c(d e) f' ))) h")
say dsnApp("'a.b c(d e) f' ))) h")
call help
call errHelp(test errHelp)
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
dsnApp: procedure
parse arg parts
dsn = ''
do wx=1 by 1
w = word(parts, wx)
if w = '' then
leave
do while w <> ''
if pos(right(w, 1), "') ") <= 0 then
leave
w = left(w, length(w)-1)
end
dsn = dsn || w
end
if pos('(', dsn) > 0 then
dsn = dsn')'
if left(dsn,1) = "'" then
return dsn"'"
else
return dsn
endProcedure dsnApp
dsnSetMbr: procedure
parse arg dsn, mbr
mbr = strip(mbr)
bx = pos('(', dsn)
if mbr = '' then do
if bx < 1 then
return dsn
else if left(dsn, 1) = "'" then
return left(dsn,bx-1)"'"
else
return left(dsn,bx-1)
end
else do
if bx < 1 then
return dsnApp(dsn '('mbr)
else
return dsnApp(left(dsn, bx) mbr)
end
endProcedure dsnSetMbr
dsnGetMbr: procedure
parse arg dsn
lx = pos('(', dsn)
rx = pos(')', dsn, lx+1)
if lx < 1 then
return ''
else if lx < rx then
return substr(dsn, lx+1, rx-lx-1)
else
return strip(substr(dsn,lx+1), 't', "'")
endProcedure dsnGetMbr
dsnGetLLQ: procedure
parse arg dsn
rx = pos('(', dsn) - 1
if rx < 0 then
rx = length(dsn)
lx = lastPos('.', dsn, rx)
return strip(substr(dsn, lx+1, rx-lx), 'b', "'")
endProcedure dsnGetLLQ
/**********************************************************************
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
***********************************************************************/
lmdTest: procedure
parse arg lev
say showTime() 'lmdTest' lev
call lmdBegin 'test', lev
say showTime() 'lmdTest after begin' lev
z = 0
do while lmdNext('test', st.)
do y=1 to st.0
z=z+1
say z word(st.y, 1)
end
end
call lmdEnd 'test'
say showTime() 'lmdTest' z 'files in' lev
return /* readTest */
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
call adrIsp 'lmdlist listid(&lmdId) option(save) group('grp')'
call adrIsp 'lmdfree listid(&lmdId)'
say showTime() 'lmdlist save' grp lev
call readBegin grp, grp'.datasets'
return /* end lmdBegin */
lmdNext:
parse arg lvGrp, lvSt
return readNext(lvGrp, lvSt)
lmdEnd: procedure
parse arg grp
call readEnd grp
return /* end lmdEnd */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsn
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
res = lmmId
if mbr <> '' then
res = res 'pattern('mbr')'
say 'lmmBegin returning' res
return res
end lmmBegin
lmmEnd: procedure
parse arg lmmId opt
if adrIspRc("LMMLIST DATAID("lmmId") option(free)") <> 0 then
if rc <> 8 then
call err "lmmEnd" id lmmId "rc" rc "for lmmList free"
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
gmRc = adrIspRc("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt)
if gmRc = 0 then
return mbr
else if gmRc = 8 | gmRC = 4 then
return ''
else
call err 'lmmList rc' gmRc
endProcedure lmmNext
/**********************************************************************
read: read a file
call sequence: readBegin, readNext*, readEnd
1. arg (dd) dd name, wird alloziert in begin und free in end
readNext liest 100 records in übergebenen stem,
returns false at eof
***********************************************************************/
readTest: procedure
parse arg dsn
say showTime() 'readTest' dsn
call readBegin 'ddEins', dsn
z = 0
do while readNext('ddEins', st.)
do y=1 to st.0
z=z+1
say z strip(st.y, 't')
end
end
call readEnd 'ddEins'
say showTime() 'readTest' z 'records in' dsn
return /* readTest */
readBegin: procedure
parse arg dd, dsn
call adrTso 'alloc dd('dd') shr reuse dsn('dsn')'
return /* end readBegin */
readNext:
parse arg lv_DD, lv_St
if adrTsoRc('execio 100 diskr' lv_DD '(stem' lv_St')') = 0 then
return 1
else if rc = 2 then
return (value(lv_St'0') > 0)
else
call err 'execio 100 diskr' lv_DD 'rc' rc
return /* end readNext */
readEnd: procedure
parse arg dd
call adrTso 'execio 0 diskr' dd '(finis)'
call adrTso 'free dd('dd')'
return /* end readEnd */
/**********************************************************************
writeApp: append lines to a file
ggDsn: dsn to append lines
ggStem stem containing line (with dot|)
ggNr number of lines, if empty <stem>.0
***********************************************************************/
writeApp:
parse arg ggDsn, ggStem, ggNr
if ggNr = '' then
ggNr = value(ggStem'0')
if pos('(', ggDsn) < 1 then do /* sequential ds, use disp=mod */
call adrTso 'alloc mod reuse dd(ddApp) dsn('ggDsn')'
end
else do /* pds: read and rewrite */
call adrTso 'alloc shr reuse dd(ddApp) dsn('ggDsn')'
if sysdsn(ggDsn) = 'OK' then do
call adrTso 'execio * diskr ddApp (stem ggL. finis)'
call adrTso 'execio' ggL.0 'diskw ddApp (stem ggL.)'
end
end
call adrTso 'execio' ggNr 'diskw ddApp (stem' ggStem 'finis)'
call adrTso 'free dd(ddApp)'
return
endProcedure writeApp
log: procedure
parse arg logLine
l.1 = date('s') time() logLine
call writeApp 'wk.out(ll)', l., 1
return
endProcedure log
/**********************************************************************
variable Expansion: replace variable by their value
***********************************************************************/
varExpandTest: procedure
m.v.eins ='valEins'
m.v.zwei ='valZwei'
m.l.1='zeile eins geht unverändert'
m.l.2='$EINS auf zeile ${ZWEI} und \$EINS'
m.l.3='...$EINS?auf zeile ${ZWEI}und $EINS'
m.l.4='...$EINS,uf zeile ${ZWEI}und $EINS$$'
m.l.5='${EINS}$ZWEI$EINS${ZWEI}'
m.l.0=5
call varExpand l, r, v
do y=1 to m.r.0
say 'old' y m.l.y
say 'new' y m.r.y
end
return
endProcedure varExpandTest
varExpand: procedure expose m.
parse arg old, new, var
varChars = ,
'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
do lx=1 to m.old.0
cx = 1
res = ''
do forever
dx = pos('$', m.old.lx, cx)
if dx < cx then do
m.new.lx = res || strip(substr(m.old.lx, cx), 't')
leave
end
res = res || substr(m.old.lx, cx, dx - cx)
if dx >= length(m.old.lx) then
call err '$ at end line m.'old'.'lx'='m.old.lx
if substr(m.old.lx, dx+1, 1) = '$' then do
res = res || '$'
cx = dx + 2
iterate
end
if substr(m.old.lx, dx+1, 1) = '{' then do
cx = pos('}', m.old.lx, dx+1)
if cx <= dx then
call err 'ending } missing line m.'old'.'lx'='m.old.lx
na = substr(m.old.lx, dx+2, cx-dx-2)
cx = cx + 1
end
else do
cx = verify(m.old.lx, varChars, 'N', dx+1);
if cx <= dx then
cx = length(m.old.lx) + 1
na = substr(m.old.lx, dx+1, cx-dx-1)
end
if symbol('m.v.na') = 'VAR' then
res = res || m.var.na
else
call err 'var' na 'not defined line m.'old'.'lx'='m.old.lx
end
m.new.0 = m.old.0
end
return /* var expand */
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggStmt, ggNo
if ggNo <> '1' then
ggStmt = 'execSql' ggStmt
address dsnRexx ggStmt
if rc = 0 then
nop /* say "sql ok:" ggStmt */
else if rc > 0 then
say "sql warn rc" rc sqlmsg()':' ggStmt
else
call err "sql rc" rc sqlmsg()':' ggStmt
return
endSubroutine adrSql
adrSqlConnect: procedure
parse arg sys
if adrTSORc("SUBCOM DSNREXX") <> 0 then do
sRC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
say 'subcom' sRc
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... */
if sqlCode = 0 then
return 'ok (sqlCode=0)'
else
return 'sqlCode='sqlCode,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x))
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
adrTso: fails if rc <> 0
adrTsoRc: returns rc without failing
***********************************************************************/
adrTsoRc:
parse arg tsoCmd
address tso tsoCmd
return rc /* end adrTsoRc */
adrTso:
parse arg tsoCmd
address tso tsoCmd
if rc <> 0 then
call err 'adrTso rc' rc 'for' tsoCmd
return /* end adrTso */
adrIspRc:
parse arg ispCmd
address ispexec ispCmd
return rc /* end adrIspRc */
adrIsp:
parse arg ispCmd
address ispexec ispCmd
if rc <> 0 then
call err 'adrIsp rc' rc 'for' ispCmd
return /* end adrIsp */
adrEdit:
parse arg editCmd, ret
address isrEdit editCmd
if rc <> 0 then
call err 'adr isrEdit rc' rc 'for' editCmd
return /* end adrEdit */
adrEditRc:
parse arg editCmd
address isrEdit editCmd
return rc /* end adrEditRc */
err:
parse arg txt
parse source s1 s2 s3 .
say 'fatal error in' s3':' txt
exit 12
errHelp: procedure
parse arg errMsg
say 'fatal error:' errMsg
call help
call err errMsg
endProcedure errHelp
help: procedure
parse source . . s3 .
say 'help for rexx' s3
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
say 'initial commentblock not found for help'
return
end
end
do lx=lx+1 by 1
li = strip(sourceLine(lx), 't', ' ')
if pos('*/', li) > 0 then
leave
say li
end
return
endProcedure help
showtime:
parse arg showmsg
return time() sysvar('syscpu') sysvar('syssrv') showmsg