zOs/REXX/CSV
/* copy csv begin ****************************************************/
/**** csvRdr reads a text file, in csv format
and creates a class from column head in first line
csvRdr#jRead returns the create objects ************************/
csv2ObjRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('Csv2ObjRdr', 'm.m.opt = arg2' ,
, 'call csv2ObjBegin m' ,
, 'call csv2Obj m, rStem, $i'), rdr, opt)
csv2ObjBegin: procedure expose m.
parse arg m
m.m.class = ''
return m
csvRdrOpenFinish: procedure expose m.
parse arg m, ff
if m.m.opt == 'u' then
upper ff
m.m.class = classNew("n* CsvF u f%v" ff)
call classMet m.m.class, 'new'
call classMet m.m.class, 'oFldD'
return m
endProcedure csvRdrOpenFinish
csv2Obj: procedure expose m.
parse arg m, wStem, li
if m.m.class == '' then
return csvRdrOpenFinish(m, space(translate(li, ' ', ','), 1))
call mAdd wStem, csv2O(mNew(m.m.class), m.m.class, li)
return
endProcedure csv2Obj
/*--- convert csv line into object of class cl ----------------------*/
csv2o: procedure expose m.
parse arg m, cl, src
ff = classMet(cl, 'oFldD')
s = csv_2o_SCAN
call scanSrc s, src
do fx=1 to m.ff.0
f1 = m || m.ff.fx
if scanString(s, '"') then
m.f1 = m.s.val
else do
call scanUntil s, ','
m.f1 = m.s.tok
end
if scanEnd(s) then
leave
if \ scanLit(s, ',') then
call scanErr s, ',' expected
end
return csv2Ofinish(m, cl, fx+1)
endProcedure csv2o
/*--- clear remaining fields and stems and mutate -------------------*/
csv2Ofinish: procedure expose m.
parse arg m, cl, fy
call classClearStems cl, oMutate(m, cl)
do fx=fy to m.cl.fldd.0
f1 = m || m.cl.fldd.fx
m.f1 = ''
end
return m
endProcedure csv2Ofinish
/**** csvWordRdr: similar to csvRdr, but input line format
are quoted or unquoted words ****************************/
csvWordRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('CsvWordRdr', 'm.m.opt = arg2' ,
, 'call csvWordBegin m' ,
, 'call csvWord m, rStem, $i'), rdr, opt)
csvWordBegin: procedure expose m.
parse arg m
m.m.class = ''
return m
csvWord: procedure expose m.
parse arg m, wStem, li
if m.m.class == '' then
return csvRdrOpenFinish(m, space(li, 1))
call mAdd wStem, csvWord2O(mNew(m.m.class), m.m.class, li)
return
endProcedure csvWord
csvWord2O: procedure expose m.
parse arg m, cl, src
ff = cl'.FLDD'
s = csv_2o_SCAN
call scanSrc s, src
do fx=1 to m.ff.0
call scanSpaceOnly s
if \ scanWord(s) then
leave
f1 = m || m.ff.fx
m.f1 = m.s.val
end
return csv2Ofinish(m, cl, fx)
endProcedure csvWord2O
/**** csvColRdr: similar to csvRdr, but input format
are fixed width columns *********************************/
/*--- create object for fixLenColumns format ------------------------*/
csvColRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('CsvColRdr', 'm.m.opt = arg2' ,
, 'call csvColBegin m' ,
, 'call csvCol m, rStem, $i'), rdr, opt)
csvColBegin: procedure expose m.
parse arg m
m.m.class = ''
return m
csvCol: procedure expose m.
parse arg m, wStem, li
if m.m.class == '' then do
s = scanSrc(csv_colOpen, li)
ff = ''
do cx=1
call scanWhile s, ' <>'
if scanEnd(s) then
leave
call scanUntil s, ' <>'
ff = ff m.s.tok
call scanSpaceOnly s
m.m.pEnd.cx = m.s.pos + (scanLook(s, 1) == '>')
end
m.m.pEnd.0 = cx-1
call csvRdrOpenFinish m, ff
return
end
call mAdd wStem, csvCol2O(m, mNew(m.m.class), m.m.class, li)
return
endProcedure csvCol
csvCol2O: procedure expose m.
parse arg oo, m, cl, src
ff = cl'.FLDD'
cx = 1
do fx=1 to m.oo.pEnd.0 - 1
f1 = m || m.ff.fx
m.f1 = strip(substr(src, cx, m.oo.pEnd.fx - cx))
cx = m.oo.pEnd.fx
end
f1 = m || m.ff.fx
m.f1 = strip(substr(src, cx))
return csv2Ofinish(m, cl, fx+1)
endProcedure csvCol2O
/*--- csv4obj add a header line
and objects of the same class in csv format ---------------*/
csv4ObjRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('Csv4ObjRdr', ,
, 'call csv4ObjBegin m' ,
, 'call csv4Obj m, rStem, $i'), rdr, opt)
csv4ObjBegin: procedure expose m.
parse arg m
m.m.class = ''
return m
endProcedure csv4ObjBegin
csv4Obj: procedure expose m.
parse arg m, wStem, o
if o == '' then do
if m.m.class \== '' then
call mAdd wStem, ''
return
end
cl = objClass(o)
if cl \== m.m.class then do
if m.m.class \== '' then
return err('class('o')='cl '<>' m.m.class)
m.m.class = cl
ff = classMet(cl, 'oFlds')
if m.ff.0 < 1 then
return err('no fields in' cl)
t = ''
do fx=1 to m.ff.0
t = t','m.ff.fx
end
call mAdd wStem, substr(t, 2)
m.m.oFldD = classMet(cl, 'oFldD')
end
call mAdd wStem, csv4O(o, m.m.oFldD, 0)
return
endProcedure csv4Obj
/*--- return the csv string for an object ---------------------------*/
csv4o: procedure expose m.
parse arg o, ff, hasNull, oNull
res = ''
do fx=1 to m.ff.0
of1 = o || m.ff.fx
v1 = m.of1
if hasNull & v1 == oNull then
res = res','
else if pos(',', v1) > 0 | pos('"', v1) > 0 | v1 == '' then
res = res','quote(v1, '"')
else
res = res','v1
end
return substr(res, 2)
endProcedure csv4o
/*--- fill empty fieldds with value of previous row -----------------*/
csvE2PrevRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('CsvE2PrevRdr', 'm.m.opt = arg2' ,
, "m.m.prev = ''" ,
, 'call csvE2Prev m, rStem, $i'), rdr, opt)
/*--- externalize o and add to wStem --------------------------------*/
csvE2Prev: procedure expose m.
parse arg m, wStem, o
if o == '' then
return
ff = oFldD(o)
hasData = 0
do fx=1 to m.ff.0
f1 = o || m.ff.fx
if m.f1 \== '' then do
hasData = 1
iterate
end
if m.m.prev == '' then
iterate
p1 = m.m.prev || m.ff.fx
m.f1 = m.p1
end
if \ hasData then
return
call mAdd wStem, o
m.m.prev = o
return
endProcedure csvE2Prev
csvColBegin: procedure expose m.
/**** csvExt externalises object into csvExt format
including object cycles and classes
csv+ protocoll, first field contains meta info ---------------------
v,text null or string
w,text w-string
c name classAdr,flds class definition
b name classAdr, class forward declaration
m name adr,text method
o classAdr adr,flds object definition and output
d classAdr adr,flds object definition wihtout output
f classAdr adr, object forward declaration
r adr, reference = output of already defined objects
* text unchanged text including ' " ...
* flds csv flds
**********************************************************************/
csvExtRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('CsvExtRdr', ,
, 'call csvExtBegin m',
, 'call csvExt m, rStem, $i'), rdr, opt)
csvExtBegin: procedure expose m.
parse arg m
d = m'.DONE'
call mapReset d, 'K'
call mapPut d, m.class_class, 'class'
call mapPut d, m.class_v, 'v'
call mapPut d, m.class_w, 'w'
call mapPut d, m.class_o, 'o'
return m
endProcedure csvExtBegin
/*--- externalize o and add to wStem --------------------------------*/
csvExt: procedure expose m.
parse arg m, wStem, o
c = objClass(o)
if c == m.class_W then
return mAdd(wStem, 'w,'substr(o, 2))
if oKindOfString(o) then
return mAdd(wStem, 'v,'o)
if c == m.class_class then
call csvExtClass m, wStem, o
if m.m.done.o == 0 then do
m.m.done.o = 1
call mAdd wStem, 'f' csvExtClass(m, wStem, c) o','
end
if symbol('m.m.done.o') == 'VAR' then
return mAdd(wStem, 'r' o',')
return mAdd(wStem, 'o' c o || csvExtObjTx(m, wStem, o))
endProcedure csvExt
csvExtObjTx: procedure expose m.
parse arg m, wStem, o
call mapAdd m'.DONE', o, 0
c = objClass(o)
if c \== m.class_class & pos(m.m.done.c, 12) < 1 then
call csvExtClass m, wStem, c
ff = classMet(c, 'oFldD')
r = ''
do fx=1 to m.ff.0
c1 = m.ff.fx.class
f1 = o || m.ff.fx
v1 = m.f1
if m.c1 == 'r' then do
c2 = objClass(v1)
if c2 == m.class_S then do
v1 = s2o(v1)
end
else if \ (c2 == m.class_N | c2 == m.class_W) then do
if m.m.done.v1 == 0 then do
m.m.done.v1 = 1
call mAdd wStem, 'f' c2 v1','
end
if symbol('m.m.done.v1') \== 'VAR' then
call mAdd wStem, 'd' c2 v1 ,
|| csvExtObjTx(m, wStem, v1)
end
end
if pos(',', v1) > 0 | pos('"', v1) > 0 then
r = r','quote(v1, '"')
else
r = r','v1
end
m.m.done.o = 2
return r
endProcedure csvExtObjTx
csvExtClass: procedure expose m.
parse arg m, wStem, c
res = mapGet(m'.DONE', c, '-')
if res == 0 then do
m.m.done.c = 1
call mAdd wStem, 'b' if(m.c.name == '', '-', m.c.name) c','
return c
end
if res == 1 then
return c
if res \== '-' then
return res
call mapAdd m'.DONE', c, 0
ty = m.c
res = if(m.c.name == '', '-', m.c.name) c
if ty == 'u' then do
res = 'c' res',u'
if m.c.0 > 0 then do
r = ''
do cx=1 to m.c.0
r = r','csvExtClassEx(m, wStem, m.c.cx)
end
res = res substr(r, 2)
end
end
else if ty == 'm' & m.c.0 == 0 then
res = 'm' res','m.c.met
else
res = 'c' res','csvExtClassEx(m, wStem, c)
call mAdd wStem, res
call mapPut m'.DONE', c, c
return c
endProcedure csvExtClass
csvExtClassEx: procedure expose m.
parse arg m, wStem, c
res = ''
ch = c
do forever
g = mapGet(m'.DONE', c, '-')
if g \== '-' then
return strip(res g)
else if m.ch == 'u' | m.ch == 'm' then
return strip(res csvExtClass(m, wStem, ch))
else if \ (length(m.ch) == 1 & pos(m.ch, 'fscr') >= 1,
& m.ch.0 <= 1 & m.ch.met == '') then
return err('csvExtClassEx bad cl' ch 'ty='m.ch,
'name='m.ch.name '.0='m.ch.0 'met='m.ch.met)
res = strip(res m.ch m.ch.name)
if m.ch.0 = 0 then
return res
ch = m.ch.1
end
endProcedure csvExtClassEx
/*--- convert variable len recs to fixLen
& = continuation, | end (to protect ' &|') -------------------*/
csvV2FRdr: procedure expose m.
parse arg rdr, arg
return oNew(jClassNew1sRdr('CsvV2FRdr', 'm.m.maxLen = arg2',
, 'call csvV2FBegin m, m.m.maxLen',
, 'call csvV2F m, rStem, $i'), rdr, arg)
csvV2FBegin: procedure expose m.
parse arg m, maxL
m.m.maxLen = word(maxL 55e55, 1)
return m
endProcedure csvV2FBegin
csvV2F: procedure expose m.
parse arg m, wStem, line
if line \== '' & pos(right(line, 1), ' &|') > 0 then
line = line'|'
if length(line) <= m.m.maxLen then
return mAdd(wStem, line)
do cx=1 by m.m.maxLen-1 to length(line)-m.m.maxLen
call mAdd wStem, substr(line, cx, m.m.maxLen-1)'&'
end
return mAdd(wStem, substr(line, cx))
endProcedure csvV2F
/*--- f2v fixLen to variable len lines: &=continuation |=endMark ----*/
csvF2VRdr: procedure expose m.
parse arg rdr, arg
return oNew(jClassNew1sRdr('CsvF2VRdr', ,
, 'call csvF2VBegin m' ,
, 'call csvF2V m, rStem, $i' ,
, 'call csvF2VEnd m'), rdr, arg)
csvF2VBegin: procedure expose m.
parse arg m
m.m.strt = ''
return m
endProcedure csvF2VBegin
csvF2V: procedure expose m.
parse arg m, wStem, aLi
li = strip(aLi, 't')
if right(li, 1) == '&' then do
m.m.strt = m.m.strt || left(li, length(li) - 1)
return
end
if right(li, 1) == '|' then
call mAdd wStem, m.m.strt || left(li, length(li) - 1)
else
call mAdd wStem, m.m.strt || li
m.m.strt = ''
return
endProcedure csvF2V
csvF2VEnd: procedure expose m.
parse arg m
if m.m.strt \== '' then
return err("csvF2vEnd but strt='"m.m.strt"'")
return m
endProcedure csvF2VEnd
/*--- internalize objects in ext format -----------------------------*/
csvIntRdr: procedure expose m.
parse arg rdr, opt
return oNew(jClassNew1sRdr('CsvIntRdr', ,
, 'call csvIntBegin m',
, 'call csvInt m, rStem, $i'), rdr, opt)
csvIntBegin: procedure expose m.
parse arg m
m.m.forward = ''
d = m'.DONE'
call mapReset d, 'K'
return
endProcedure csvIntBegin
csvInt: procedure expose m.
parse arg m, wStem, line
parse var line hd ',' rest
parse var hd h1 h2 h3 hr
d = m'.DONE'
if pos(h1, 'vwr') > 0 then do
if m.m.forward \== '' then
return err('csvInt: forward='m.m.forward 'not empty:' line)
if h1 == 'v' & h2 == '' then
return mAdd(wStem, rest)
if h1 == 'w' & h2 == '' then
return mAdd(wStem, m.o_escW || rest)
if h1 \== 'r' | h2 == '' | h3 \== '' | rest \== '' then
return err('csvInt: bad line' line)
r = mapGet(d, h2, '')
if r == '' then
return err('csvInt: undefined reference' line)
return mAdd(wStem, r)
end
if h3=='' | hr\=='' | length(h1)\==1 | pos(h1, 'bcmdfo') < 1 then
return err('csvInt: bad line' line)
if h1 == 'b' | h1 == 'f' then do
if symbol('m.d.h3') == 'VAR' then
return err('csvInt: forward already defined:' line)
if h1 == 'b' then do
if h2 == '-' then
h2 = 'CsvForward'
n = classNew('n' h2 || (m.class.0+1) 'u')
m.n.met = h2'*'
end
else do
cl = mapGet(d, h2, '')
if cl == '' then
return err('csvInt: undefined class:' line)
n = mNew(cl)
end
call mapAdd d, h3, n
m.m.forward = m.m.forward h3
return
end
if h1 == 'm' then do
n = classNew('m' h2 rest)
return mapAdd(d, h3, n)
end
if h1 == 'c' then do
rx = 1
rr = ''
do while rx <= length(rest)
ry = pos(',', rest, rx+1)
if ry < 1 then
ry = length(rest)+1
r1 = substr(rest, rx, ry-rx)
rI = wordIndex(r1, words(r1))
if rI == 1 & abbrev(r1, ',') then
rI = 2
rL = strip(substr(r1, rI))
if length(rL) \== 1 | pos(rL, 'vwor') < 1 then do
rL = mapGet(d, rL, '')
if rL == '' then
return err('csvInt undef class' rL 'line:' line)
end
rr = rr || left(r1, rI-1)rL
rx = ry
end
end
fx = wordPos(h3, m.m.forward)
if fx > 0 then do
m.m.forward = strip(delWord(m.m.forward, fx, 1))
n = mapGet(d, h3)
if h1 == 'c' then do
call classNew 'n=' m.n.name rr
call classMet n, 'new'
return
end
cl = 'CLASS'substr(n, 2, pos('.', n, 3)-2)
if cl \== mapGet(d, h2) then
return err('csvInt: forward class' cl 'mismatches' line)
end
else do
if mapHasKey(m, d, h3) then
return err('already defined:' line)
if h1 == 'c' then do
do while datatype(right(h2, 1), 'n')
h2 = left(h2, length(h2)-1)
end
if h2 == '-' then
h2 = 'CsvForward'
s = ''
cl = classNew(copies('n*' h2' ', h2 \== '-')rr)
call classMet cl, 'new'
return mapAdd(d, h3, cl)
end
cl = mapGet(d, h2, '')
if cl == '' then
return err('undefined class:' line)
n = mNew(cl)
call mapAdd d, h3, n
end
call csv2o n, cl, rest
ff = classFldD(cl)
do fx=1 to m.ff.0
f1 = n || m.ff.fx
c1 = m.ff.fx.class
if m.c1 \== 'r' | m.f1 == '' | abbrev(m.f1, m.o_escW) then
iterate
t1 = mapGet(d, m.f1, '')
if t1 == '' then
return err('missing reference' fx m.f1 'in' line)
m.f1 = t1
end
if h1 == 'o' then do
if m.m.forward \== '' then
call err 'forward not empty:' line
call mAdd wStem, n
end
return
endProcedure csvInt
/* copy csv end ****************************************************/