zOs/REXX/SQLDIV
/* copy sqlDiv begin *************************************************/
/*--- generate the format m for a sql cx as specified in sp
use the information from the sqlDa ------------------------*/
sqlFTabReset: procedure expose m.
parse arg ff, maxCh, maxBlo, maxDe
return sqlFTabOpts(fTabReset(ff, , , '-'), maxCh, maxBlo, maxDe)
/*--- default formats per datatype ----------------------------------*/
sqlFTabOpts: procedure expose m.
parse arg ff, m.ff.maxChar, m.ff.blobMax, m.ff.maxDec
if m.ff.maxChar == '' then
m.ff.maxChar = 32
if m.ff.blobMax == '' then
m.ff.blobMax = 200
bf = '%-'max(m.ff.blobMax, 4)'C'
m.ff.sql2fmt.384 = '%-10C' /* date */
m.ff.sql2fmt.388 = '%-8C' /* time */
m.ff.sql2fmt.392 = '%-26C' /* timestamp */
m.ff.sql2fmt.400 = 'c' /* graphic string */
m.ff.sql2fmt.404 = bf /* BLOB */
m.ff.sql2fmt.408 = bf /* CLOB */
m.ff.sql2fmt.412 = bf /* DBCLOB */
m.ff.sql2fmt.448 = 'c' /* varchar */
m.ff.sql2fmt.452 = 'c' /* char */
m.ff.sql2fmt.452 = 'c' /* long varchar */
m.ff.sql2fmt.460 = 'c' /* null term. string */
m.ff.sql2fmt.464 = 'c' /* graphic varchar */
m.ff.sql2fmt.468 = 'c' /* graphic char */
m.ff.sql2fmt.472 = 'c' /* long graphic varchar */
m.ff.sql2fmt.480 = '%-7e' /* float */
m.ff.sql2fmt.484 = 'd' /* packed decimal */
m.ff.sql2fmt.492 = '%20i' /* bigInt */
m.ff.sql2fmt.496 = '%11i' /* int */
m.ff.sql2fmt.500 = '%6i' /* smallInt */
m.ff.sql2fmt.904 = '%-34H' /* rowID 17 Byte Binary */
return ff
endProcedure sqlFTabOpts
/*--- set a defaultFormat for type tx in fTab ff --------------------*/
sqlFTabDef: procedure expose m.
parse arg ff, tx, m.ff.sql2fmt.tx
return ff
/*--- complete / override column info from sqlCa --------------------*/
sqlFTabComplete: procedure expose m.
parse arg m, cx, aOth, aFmt
if aOth then
call sqlFTabOthers m, cx
f2x = classMet(sqlFetchClass(cx), 'f2x')
do tx=1 to m.m.0
c1 = m.m.tx.col
if symbol('m.m.set.c1') == 'VAR' then do
sx = m.m.set.c1
parse var m.m.set.sx c1 aDone
m.m.tx.done = aDone \== 0
m.m.tx.fmt = m.m.set.sx.fmt
m.m.tx.labelSh = m.m.set.sx.labelSh
end
if symbol('m.f2x.c1') \== 'VAR' then
iterate
kx = m.f2x.c1
if m.m.tx.labelLo = '' then
m.m.tx.labelLo = m.sql.cx.d.kx.sqlName
if m.m.tx.labelSh = '' then
m.m.tx.labelSh = m.sql.cx.d.kx.sqlName
if m.m.tx.fmt <> '' | \ aFmt then
iterate
/* use format for datatype */
ty = m.sql.cx.d.kx.sqlType
ty = ty - ty // 2 /* odd = with null */
le = m.sql.cx.d.kx.sqlLen
if symbol('m.m.sql2fmt.ty') <> 'VAR' then
call err 'sqlType' ty 'col' c1 'not supported'
f1 = m.m.sql2fmt.ty
if f1 == 'c' then
f1 = '%-'min(le, m.m.maxChar)'C'
else if f1 == 'd' then do
pr = m.sql.cx.d.kx.sqlLen.sqlPrecision
sc = m.sql.cx.d.kx.sqlLen.sqlScale
if sc < 1 then
f1 = '%' || (pr + 1) || 'i'
else
f1 = '%' || (pr + 2) || '.'sc'i'
end
if \ abbrev(f1, '%') then
call err 'sqlType' ty 'col' c1 'bad format' f1
m.m.tx.fmt = f1
end
return m
endProcedure sqlFTabComplete
/*--- add all cols of sqlCA to fTab,
that are not yet (witho aDone=0) ----------------------*/
sqlFTabOthers: procedure expose m.
parse arg m, cx
do cy=1 to m.m.0
if m.m.cy.done then do
nm = m.m.cy.col
done.nm = 1
end
end
ff = m.sql.cx.fetchFlds
do kx=1 to m.sql.cx.d.sqlD
c1 = word(ff, kx)
if done.c1 \== 1 then
call ftabAdd m, c1
end
return m
endProcedure sqlFTabOthers
/*--- fetch all rows from cursor cx, tabulate and close crs
opt = a autoformat from data
c column format (each column on separate line)
s silent
o ouput objects
q format by sqlCA ----------------------------------*/
sqlFTab: procedure expose m.
parse arg m, cx
if pos('o', m.m.opt) < 1 then
call sqlFTabComplete m, cx, pos('|', m.m.opt) < 1,
, pos('a', m.m.opt) < 1
if verify(m.m.opt, 'ao', 'm') > 0 then
return fTab(m, sqlQuery2Rdr(cx))
/* fTab would also work in other cases,
however, we do it without sqlQuery2Rdr */
dst = 'SQL_fTab_dst'
if pos('c', m.m.opt) > 0 then do
if pos('c', m.m.generated) < 1 then
call fTabGenCol m
do rx=1 while sqlFetch(cx, dst)
call out left('--- row' rx '', 80, '-')
call fTabCol m, dst
end
call out left('--- end of' (rx-1) 'rows ', 80, '-')
end
else do
call fTabBegin m
do rx=1 while sqlFetch(cx, dst)
call out f(m.m.fmt, dst)
end
call fTabEnd m
end
call sqlClose cx
return m
endProcedure sqlFTab
/*--- create insert statment into table tb
for object m in spufi (72chars) format ---------------------*/
sql4obj: procedure expose m.
parse arg m, tb
call out 'insert into' tb '--' className(objClass(m))
line = ''
ff = oFldD(m)
pr = ' ('
do fx=1 to m.ff.0
call sql4ObjOut substr(m.ff.fx, 2)
end
call sql4ObjOut , 1
call out ' ) values '
pr = ' ('
do fx=1 to m.ff.0
f1 = m || m.ff.fx
v = m.f1 /* no strip T, gives errors in RCM profile | */
if dataType(v, n) then
call sql4ObjOut v
else do qx=1 until v == ''
vx = verify(v, m.ut_alfPrint)
if vx = 0 then do
l1 = min(60, length(v))
w = quote(left(v, l1), "'")
end
else if vx > 29 then do
l1 = min(60, vx-1)
w = quote(left(v, l1), "'")
end
else do
l1 = min(29, length(v))
w = 'x'quote(c2x(left(v, l1)), "'")
end
if qx == 1 then
call sql4ObjOut w
else do
if qx = 2 then
call sql4ObjOut , 1
call out ' ||' w
end
v = substr(v, l1+1)
end
end
call sql4ObjOut , 1
call out ' ) ; '
return
endProcedure
sql4objOut:
parse arg t1, force
if (force == 1 & line \== '') | length(line t1) > 65 then do
call out pr substr(line, 3)
pr = ' ,'
line = ''
end
if force \== 1 then
line = line',' t1
return
endProcedure sql4objOut
/*--- -dis db interface ---------------------------------------------*/
/*--- do one -dis db... and insert it into stem --------------------*/
sqlDisDb: procedure expose m.
parse upper arg o, cc
do cx=1
mid = strip(left(m.cc.cx, 10))
if words(mid) > 1 then
call err 'bad msgId' mid 'line:' m.cc.cx
if mid == '' | wordPos(mid, 'DSNT360I DSNT361I DSNT365I') ,
> 0 then
iterate
if mid == 'DSN9022I' then
if cx = m.cc.0 then
return m.o.0
else
call err 'not at end' cx':' m.cc.cx
if mid \== 'DSNT362I' then
call err 'DSNT362I expected not line:' m.cc.cx
dx = pos('DATABASE =', m.cc.cx)
sx = pos('STATUS =' , m.cc.cx)
if dx < 1 | sx <= dx then
call err 'bad DSNT362I line' cx':' m.cc.cx
db = word(substr(m.cc.cx, dx+10), 1)
sta = strip(substr(m.cc.cx, sx+8))
call sqlDisDbAdd o, db, ,0, 0, 'DB', sta
do cx=cx+1 while abbrev(m.cc.cx, ' ')
end
if abbrev(m.cc.cx, 'DSNT397I ') then do
cx = cx + 1
if \ abbrev(space(m.cc.cx, 1),
, 'NAME TYPE PART STATUS ') then
call err 'NAME TYPE PART STATUS mismatch' cx m.cc.cx
txNa = pos('NAME', m.cc.cx)
txTy = pos('TYPE', m.cc.cx)
txPa = pos('PART', m.cc.cx)
txSt = pos('STAT', m.cc.cx)
txEn = verify(m.cc.cx, ' ', 'n', txSt+6)
if 0 then say 'title' txNa txTy txPa txSt txEn cx m.cc.cx
cx=cx+1
do forever
do while abbrev(m.cc.cx, '----')
cx = cx + 1
end
if abbrev(m.cc.cx, '*') then
leave
parse var m.cc.cx sp =(txTy) ty . =(txPa) paFr . ,
=(txSt) sta =(txEn)
sp = strip(sp)
if words(sp) \= 1 | wordPos(ty, 'TS IX') < 0 then
call err 'bad name or type' cx':'m.cc.cx
if paFr == '' | paFr == 'L*' then
paFr = 0
else if abbrev(paFr, 'D') | abbrev(paFr, 'L') then
paFr = substr(paFr, 2)
if \ datatype(paFr, 'n') then
call err 'part not numeric' cx':'m.cc.cx
paTo = paFr
cw = cx
cx = cx + 1
if abbrev(m.cc.cx, ' -THRU ') then do
parse var m.cc.cx =(txPa) paTo . =(txSt)
if \ datatype(paTo, 'n') then
call err '-thru part not numeric' cx':'m.cc.cx
cx = cx + 1
end
call sqlDisDbAdd o, db, sp, paFr, paTo, ty, sta
end
end
if m.cc.cx = '******** NO SPACES FOUND' then
cx = cx + 1
if abbrev(m.cc.cx, '******* DISPLAY OF DATABASE ') ,
& word(m.cc.cx,5) == db then
if word(m.cc.cx,6) == 'ENDED' then
iterate
else if word(m.cc.cx,6) == 'TERMINATED' then
call err 'db display overflow' cx':' m.cc.cx
call err 'database' db 'ENDED mismatch' cx':' m.cc.cx
end
endProcedure sqlDbDis
/*--- insert one tuple into tDbState --------------------------------*/
sqlDisDbAdd: procedure expose m.
if arg(7) == '' | arg(7) == 'RW' then
return
parse arg o
m.o.0 = m.o.0 + 1
q = o'.'m.o.0
parse arg , m.q.db, m.q.sp, m.q.paFr, m.q.paTo, m.q.ty, m.q.sta
/*say added q m.q.db'.'m.q.sp':'m.q.paFr'-'m.q.paTo m.q.ty':'m.q.sta*/
ky = m.q.db'.'m.q.sp
if symbol('m.o.ky') \== 'VAR' then
m.o.ky = m.o.0
return
endProceedure sqlDisDbAdd
/*--- get index in o for db sp part ---------------------------------*/
sqlDisDbIndex: procedure expose m.
parse arg st, d, s, pa
if symbol('m.st.d.s') \== 'VAR' then
return 0
ix = m.st.d.s
if ix > m.st.0 | d \== m.st.ix.db | s \== m.st.ix.sp then
return 0
if pa == '' then
return ix
do ix=ix to m.st.0 while d == m.st.ix.db & s == m.st.ix.sp
if pa < m.st.ix.paFr then
return 0
else if pa <= m.st.ix.paTo then
return ix
end
return 0
endProcedure sqlDisDbIndex
/*--- dsn Command, return true if continuation needed ---------------*/
sqlDsnCont: procedure expose m.
parse arg cc, ssid, cmd
say '???dsnCont' cmd
cont = sqlDsn(cc, ssid, cmd, 12) <> 0
if cont then do
cz = m.cc.0
cy = cz - 1
if \ abbrev(m.cc.cy, DSNT311I) ,
| \ abbrev(m.cc.cz, 'DSN9023I') then
call err 'sqlDsn rc=12 for' cmd 'out='cz ,
'\n'cy'='m.cc.cy'\n'cz'='m.cc.cz
m.cc.0 = cz-2
end
return cont
endProcedure sqlDsnCont
/* copy sqlDiv end *************************************************/