zOs/REXX.O08/SCANSQL
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSql: procedure expose m.
parse arg inRdr
return scanSqlReset(scanWin(inRdr), inRdr)
scanSqlReset: procedure expose m.
parse arg m, rdr, scanWin
if scanWin ^== 0 then
call scanWinReset m, rdr, 5, 2, 1, 72
else
m.m.read = rdr
return scanOpts(m, , '0123456789_' , '--')
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd, opts
if opts = '' then
opts = word
if adrEdit("cursor =" max(trunc(lx), 1), 12) = 12 then
return -1
do while adrEdit("seek" cmd opts, 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
if m.debug then do
call adrEdit "(LI) = LINE" fx
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx li
end
call editReadReset m.m.read, fx
call scanWinOpen es, fx
do while word(scanPos(m), 1) <= fx & scanSqlType(m)
if m.m.sqlType = 'i' & m.m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': qualified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
's': string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSqlType: procedure expose m.
parse arg m, retSpace
m.m.val = ''
if scanSpaceNl(m) & retSpace = 1 then do
m.m.sqlType = 'b'
return 1
end
c2 = scanLook(m ,2)
if scanString(m, "' x' X'") then do
m.m.sqlType = 's'
if ^abbrev(m.m.tok, "'") then
m.m.val = x2c(m.m.val)
end
else if scanSqlQuId(m) then do
if m.m.val.0 > 1 then
m.m.sqlType = 'q'
else if abbrev(m.m.tok, '"') then
m.m.sqlType = 'd'
else
m.m.sqlType = 'i'
end
else if scanSqlNum(m, 0, 1) then
m.m.sqlType = 'n'
else if scanChar(m, 1) then
m.m.sqlType = m.m.tok
else if scanAtEnd(m) then do
m.m.sqlType = ''
return 0
end
else
call scanErr m, 'cannot scan sql'
return 1
endProcedure scanSqlType
scanSqlSkipBrackets: procedure expose m.
parse arg m, br
if br ^== '' then
nop
else if scanLit(m, '(') then
br = 1
else
return 0
do while scanSqlType(m) & m.m.sqlType ^== ';'
if m.m.sqlType = '(' then br = br + 1
else if m.m.sqlType ^== ')' then iterate
else if br > 1 then br = br - 1
else return 1
end
call scanErr m, '; or eof, but' br 'closing ) expected'
endProcedure skipBrackets
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return 0
m.m.val = translate(m.m.tok)
return 1
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) then
return 1
if ^ scanString(m, '"') then
return 0
m.m.val = strip(m.m.val, 't')
return 1
endProcedure scanSqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
res = ''
rto = ''
do qx=1
if ^ scanSqlDeId(m) then do
if qx <> 1 then
call scanErr m, 'id expected after .'
return 0
end
m.m.val.qx = m.m.val
res = res'.'m.m.val
rto = rto'.'m.m.tok
if ^ scanLit(scanSkip(m), '.') then
leave
call scanSpaceNl m
end
m.m.val.0 = qx
m.m.val = substr(res, 2)
m.m.tok = substr(rto, 2)
return 1
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd, noSp
n = ''
if scanLit(m, '+', '-') then do
n = m.m.tok
if noSp <> 1 then
call scanSpaceNl m
end
if scanLit(m, '.') then
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.m.tok
else if n == '' then
return 0
else if noSp = 1 then do
call scanBack m, n
return 0
end
else
call scanErr m, 'scanSqlNum bad number: no digits after' n
if pos('.', n) < 1 then
if scanLit(m, '.') then do
if scanVerify(m, '0123456789') then
n = n'.'m.m.tok
end
if scanLit(m, 'E', 'e') then do
n = n'E'
if scanLit(m, '+', '-') then
n = n || m.m.tok
if ^ scanVerify(m, '0123456789') then
call scanErr m, 'scanSqlNum bad number: no digits after' n
n = n || m.m.tok
end
if checkEnd ^= 0 then
if pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNum number' n 'bad end' ,
scanLook(m, 1)
m.m.val = n
return 1
endProcedure scanSqlNum
/*--- scan a sql number with a unit which may follow without space ---*/
scanSqlNumUnit: procedure expose m.
parse arg m, both, units
if ^ scanSqlNum(m, 0) then
return 0
nu = m.m.val
sp = scanSpaceNl(m)
if scanSqlId(m) then do
if units == '' | wordpos(m.m.val, units) > 0 then
nu = nu m.m.val
else if both | ^ sp then
call scanErr m, 'scanSqlNumUnit after' nu 'bad unit' m.m.val
else
call scanBack m, m.m.tok
end
else if both then
call scanErr m, 'scanSqlNumUnit no unit after' nu
else if ^sp & pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNumUnit bad number end after' nu
m.m.val = nu
return 1
endProcedure scanSqlNumUnit
/* copy scanSql end *************************************************/