zOs/REXX.O08/SQLO

/* copy sqlO   begin ***************************************************
    sql interface  mit  o und j Anbindung
***********************************************************************/
sqlOini: procedure expose m.
    if m.sqlO.ini == 1 then
        return
    m.sqlO.ini = 1
    call sqlIni
    call envIni
    call oDecMethods oNewClass("SqlType", "JRW"),
        , "jOpen  call sqlOpen substr(m, 8); m.m.jReading = 1",
        , "jClose call sqlClose substr(m, 8)",
        , "jRead  return sqlFetch(substr(m, 8), var)"
    call oDecMethods oNewClass("SqlLn", "SqlType"),
        , "jRead  return sqlFetchLn(substr(m, 8), var)"
    return
endProcedure sqlOini
/*--- fetch all rows into stem st
           from sql src using type ty and format fmt -----------------*/
sql2St: procedure expose m.
parse arg st, src, ty, fmt
    cx = 49
    call sql2Cursor cx, src, ty, fmt
    call sqlOpen cx
    do ix=1 by 1 while sqlFetch(cx, st'.'ix)
        end
    m.st.0 = ix-1
    call sqlClose cx
    return ix-1
endProcedure sql2St

/*--- prepare statement 's'cx and declare cursor 'c'cx from sql src
           use or generate type ty and format fo ---------------------*/
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
     call sqlPreDeclare cx, src, 1  /* with describe output */
     call sqlGenType cx, ty
     m.Sql.cx.FMT.0 = 0
     m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
     call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
     return
endProcedure sql2Cursor

/*--- return the type for sql cx -------------------------------------*/
sqlType: procedure expose m.
parse arg cx
    return oGetTypePara('SQL.TY.'cx)

/*--- fetch cursor 'c'cx into destination dst
          each column is formatted and assigned to m.dst.<colName> ---*/
sqlFetch: procedure expose m.
parse arg cx, dst
    if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
        return 0
    if dst == '' then
        return 1
    fi = oFlds(sqlType(cx))
    fo = m.sql.cx.fmt
    do ix=1 to m.sql.cx.d.SQLD
        f = m.fi.ix
        if m.sql.cx.d.ix.sqlInd = 0 then
            m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
        else
            m.dst.f = fmtS(m.sqlNull, m.fo.ix)
        end
    return 1
endProcedure sqlFetch

/*--- fetch cursor 'c'cx
          put the formatted and concatenated columns into m.var
          return 1 if a row fetched, 0 if not ------------------------*/
sqlFetchLn: procedure expose m.
parse arg cx, var
    st = 'SQL.'cx'.FET'
    if ^ sqlFetch(cx, st) then
        return 0
    m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
    return 1
endProcedure sqlFetchLn

/*--- generate the type sql cx as specified in ty
          use the information from the sqlDa -------------------------*/
sqlGenType: procedure expose m.
parse arg cx, ty
     if ty == '*' | ty = '' then do
         ff = ''
         do ix=1 to m.sql.cx.d.sqlD
             f1 = word(m.sql.cx.d.ix.sqlName, 1)
             if f1 == '' then
                 f1 = 'COL'ix
             ff = ff f1
             end
         ty = oFldOnly(ff, 'e')
         end
     call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
     return ty
endProcedure sqlGenType

/*--- generate the format ff for a sql cx as specified in sp
          use the information from the sqlDa -------------------------*/
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
    if abbrev(sp, '=') then
        return substr(sp, 2)
    if sp = '' then
        sp = '*st'
    m.ff.0 = m.sql.cx.d.sqlD
    m.ff.flds = oFlds(sqlType(cx))
    if abbrev(sp, '*') then do
        do ix=1 to m.ff.0
            m.ff.ix = substr(sp, 2)
            end
        return ff
        end
    if abbrev(fmts, '=') then
        m.Sql.cx.FMT = substr(fmts, 2)
    defs = 'ir7 fr9 sl12 Tl26' sp
    do wx = 1 to words(defs)
        parse value word(defs, wx) with ty 2 fo
        select
            when ty = 'd' then      t.384 = fo
            when ty = 'f' then      t.480 = fo'/f'
            when ty = 'i' then      t.496 = fo'/i'
            when ty = 'n' then      t.484 = fo'/n'
            when ty = 's' then      t.448 = fo
            when ty = 't' then      t.388 = fo
            when ty = 'T' then      t.392 = fo
            otherwise          call err 'bad type' ty 'for format' fo
            end
        end
    if symbol('t.496') == 'VAR' then
        t.500 = t.496
    if symbol('t.448') == 'VAR' then do
        t.452 = t.448
        t.456 = t.448
        t.464 = t.448
        end
    do wx = 1 to m.ff.0
        ty = m.sql.cx.d.wx.sqlType
        le = m.sql.cx.d.wx.sqlLen
        withNulls = ty // 2
        ty = ty - withNulls
        if symbol('t.ty') <> 'VAR' then
            call err 'sqlType' ty 'not supported'
        parse var t.ty fo 2 fl '/' op
        if op = 'i' then
             if le = 2 then le = 6
             else           le = 12
        else if op <> '' then
            call err 'length for sqlType' ty 'op' op 'not implemented'
        if fl = '=' then
            fl = le
        else if abbrev(fl, '<') then
            fl = min(le, substr(fl, 2))
        m.ff.wx = fo || fl
        end
    return ff
endProcedure sqlGenFmt
/*--- sql o interface ------------------------------------------------*/
/*--- return a reader for the givenn sql or std input ----------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
    if ty = '' then
        ty = '*'
    if src == '' then
        src = envCatStr(' ', 'sb')
    call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
    call oMutate 'SQL.TY.'cx, 'SqlType'
    return 'SQL.TY.'cx
endProcedure sql2obj

/*--- write to std output the result columns of
          the sql given in src or std input --------------------------*/
sql: procedure expose m.
parse arg cx, src, ty, fo
    call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
    return
endProcedure sql

/*--- write to std output the result lines   of
          the sql given in src or std input --------------------------*/
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
    if fo = '' then
        fo = '~'
    squash = abbrev(fo, '~')
    if ^ abbrev(fo, '=') then
        fo = left(fo, squash) 'sl=' substr(fo, squash+1)
    t = sql2Obj(cx, src, ty, fo)
    if squash then do
        call fmtFldSquashRw t, 'opCl'
        return
        end
    m = 'SQL.LN.'cx
    call oMutate m, 'SqlLn'
    call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
    call jWriteAll m.j.jOut, "r£", m
    return
endProcedure sqlLn
/* copy sqlO   end   **************************************************/