zOs/REXX/DB2CAT

/* copy db2Cat begin *************************************************/
catTbLastCol: procedure expose m.
parse upper arg cr, tb
    return sql2one( ,
          "select strip(char(colcount)) || ' ' || strip(c.name) one"  ,
              "from sysibm.sysTables t left join sysibm.sysColumns c" ,
                  "on c.tbCreator = t.creator and c.tbName = t.name"  ,
                       "and c.colNo = t.colCount"                     ,
               "where t.creator = '"cr"' and t.name = '"tb"'",,,, 'r')
endProcedure catTbLastCol

catTbCols: procedure expose m.
parse upper arg cr, tb
    if sql2St("select strip(name) name "     ,
          "from sysibm.sysColumns " ,
          "where tbcreator = '"cr"' and tbname='"tb"'",
          "order by colNo", ggSt) < 1 then
        return ''
    res = m.ggst.1.name
    do cx=2 to m.ggst.0
        res = res m.ggst.cx.name
        end
    return res
endProcedure catTbCols

catTbColsTrunc: procedure expose m.
parse upper arg cr, tb, maxL
    if sql2St("select strip(name) name, colType, length, length2"     ,
          "from sysibm.sysColumns " ,
          "where tbcreator = '"cr"' and tbname='"tb"'",
          "order by colNo", ggSt) < 1 then
        return ''
    res = ''
    do cx=1 to m.ggst.0
        ty = m.ggSt.cx.colType
        if pos('LOB', ty) > 0 then
            res = res', substr('m.ggSt.cx.name', 1,' ,
                 min(maxL, m.ggSt.cx.length2)') 'm.ggSt.cx.name
        else if pos('CHAR', ty) > 0 & m.ggSt.cx.length > maxL then
            res = res', substr('m.ggSt.cx.name', 1,' maxL')',
                 m.ggSt.cx.name
        else
            res = res',' m.ggSt.cx.name
        end
    return substr(res, 3)
endProcedure catTbColsTrunc

catIxKeys: procedure expose m.
parse upper arg cr, ix
    sql = "select colSeq sq, colName col, ordering ord"       ,
              "from sysibm.sysKeys"                                   ,
               "where ixCreator = '"cr"' and ixName = '"ix"'" ,
               "order by colSeq"
    call sqlQuery 1, sql
    res = ''
    drop d
    do kx=1 while sqlFetch(1, d)
        if m.d.sq \= kx then
            call err 'expected' kx 'but got colSeq' m.d.sq ,
                     'in index' cr'.'ix'.'m.d.col
        res = res || strip(m.d.col) || translate(m.d.ord, '<>?', 'ADR')
        end
    call sqlClose 1
    return res
endProcedure catIxKeys

catColCom: procedure expose m.
parse upper arg fCr, fTb, tCr, tTb
    sql = "select t.name, t.colType, t.nulls, t.""DEFAULT"""        ,
                    ", coalesce(f.nulls, 'new')"                    ,
              "from sysibm.sysColumns t"                            ,
                "left join sysibm.sysColumns f"                     ,
                  "on f.tbCreator = '"fCr"' and f.tbName = '"fTb"'" ,
                    "and f.name = t.name"                           ,
              "where t.tbCreator = '"tCr"' and t.tbName = '"tTb"'"  ,
              "order by t.colNo"
    call sqlQuery 1, sql, 'na ty nu de nn'
    pr = ' '
    do kx=1 while sqlFetch(1)
        /* say kx m..na m..ty m..nu m..de 'nn' m..nn */
        if pos('CHAR', m..ty) > 0 then
            dv = "''"
        else if pos('INT' ,m..ty) > 0 ,
                | wordPos(m..ty, 'REAL FLOAT') > 0 then
            dv = 0
        else if m..ty == 'TIMESTMP' then
            dv = '0001-01-01-00.00.00'
        else if pos('LOB', m..ty) > 0 then
            dv = m..ty"('')"
        else
            dv = '???'
        if m..nu = 'Y' then
            dv = 'case when 1=0 then' dv 'else null end'
        r = '???'
        if m..ty = 'ROWID' then do
            r = '--'
            end
        else if m..nn == 'new' then do
            if m..de = 'Y' then
                r = '--'
            else if m..nu == 'N' then
                r = dv
            else
                r = 'case when 1=0 then' dv 'else null end'
            end
        else do
            if m..nu = 'Y' | (m..nu = m..nn) then
                r = ''
            else
                r = 'coalesce('m..na',' dv')'
            end
        if abbrev(r, '--') then do
            r = ' ' r
            end
        else do
            r = pr r
            pr = ','
            end
        if pos('???', r) > 0 then
            call err 'no default for type' m..ty 'in' tCr'.'tTb'.'m..na
        call out r m..na
        end
    call sqlClose 1
    return
endProcedure catColCom
/* copy db2Cat end   *************************************************/