zOs/REXX.O08/CAT

/* copy cat  begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
     if abbrev(opt, '<') then
         o = 'r'substr(opt, 2)
     else if abbrev(opt, '>>') then
         o = 'a'substr(opt, 3)
     else if abbrev(opt, '>') then
         o = 'w'substr(opt, 2)
     else if pos(left(opt, 1), 'rwa') > 0 then
         o = opt
     else
         o = '?'opt
     if keep ^== 1 then
         o = translate(o, ' ', '£#')
     return space(o, 0)
endProcedure catOpt

/*--- create and possibly open a reader or writer --------------------*/
catMake: procedure expose m.
parse arg opt, spec
    o = catOpt(opt, 1)
    if pos('£', o) > 0 then
        return spec
    else if pos('#', o) > 0 then do
        if envhasKey(spec) then
            return catMake(translate(opt, '£', '#'), envGet(spec))
        else
            return envPut(spec, jBuf())
        end
    else if pos('&', o) > 0 then
        return catDsn('&'spec)
    else
        return catDsn(spec)
    call err 'catMake implement' opt
    if defDsn == '' then do
        o = left(o, length(o)-1)
        end
    else if defDsn == '' then do
        rw = catDsn(spec)
        end
    else do
        rw = jReset(defDsn, spec)
        end
    if pos('-', o) < 1 then
        call jOpen rw, o
    return rw
endProcedure catMake

/*--- create a new cat -----------------------------------------------*/
cat: procedure expose m.
    m = oNew('Cat')
    m.m.catIx = -9
    call catReset m
    do ax=1 by 2 to arg()
        call catWriteAll m, arg(ax), arg(ax+1)
        end
    return m
endProcedure cat

catReset: procedure expose m.
parse arg m
    m.m.RWs.0 = 0
    m.m.catWr = ''
    m.m.catRd = ''
    m.m.catToClose = ''
    m.m.catIx = -9
    call oSetTypePara m
    do ax=2 by 2 to arg()
        call catWriteAll m, arg(ax), arg(ax+1)
        end
    return m
endProcedure catReset

catClose: procedure expose m.
parse arg m
    if m.m.catIx == -9 then
        return
    if m.m.catWr ^== '' then do
        call jClose m.m.catWr
        bx = mInc(m'.RWS.0')
        m.m.opts.bx = ""
        m.m.RWs.bx = m.m.catWr
        m.m.catWr = ''
        end
    if m.m.catIx >= 0   then do
        if m.m.catRd ^== '' then do
            ix = m.m.catIx
            if pos('-', m.m.opts.ix) < 1 then
                call jClose m.m.catRd
            m.m.catRd = ''
            end
        do wx = 1 to words(m.m.catToClose)
            cl = word(m.m.catToClose, wx)
            if cl ^== m then
                call jClose cl
            end
        m.m.catToClose = ''
        end
    m.m.catIx = -9
    return m
endProcedure catClose

catOpen: procedure expose m.
parse arg m, oo
    call jClose m
    if oo = 'r' then do
        m.m.catIx = 0
        m.m.catRd = catNextRdr(m)
        m.m.jReading = 1
        end
    else if oo == 'w' | oo == 'a' then do
        if oo == 'w' then
            m.m.RWs.0 = 0
        m.m.catIx = -7
        m.m.jWriting = 1
        end
    else do
        call err 'catOpen('m',' oo') bad opt'
        end
    return m
endProcedure catOpen

/*--- return and open next reader ------------------------------------*/
catNextRdr: procedure expose m.
parse arg m
    cx = m.m.catIx
    if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
        call jClose m.m.catRd
    cx = cx + 1
    m.m.catIx = cx
    if cx > m.m.RWs.0 then
        return ''
    oo = overlay('r', m.m.opts.cx)
    if pos('-', oo) < 1 then
        call jOpen m.m.RWs.cx, oo
    return m.m.RWs.cx
endProcedure catNextRdr

catRead: procedure expose m.
parse arg m, var
    do while m.m.catRd ^== ''
        if jRead(m.m.catRd, var) then
            return 1
        m.m.catRd = catNextRdr(m)
        end
    return 0
endProcedure catRead

catWrite: procedure expose m.
parse arg m, line
    if m.m.catWr == '' then do
        m.m.catWr = jOpen(jBuf(), 'w')
        call oSetTypePara m.m.catWr, oGetTypePara(m)
        end
    call jWrite m.m.catWr, line
    return
endProcedure catWrite

/*--- write contents of a reader to cat
          or keep it for later reading -------------------------------*/
catWriteAll: procedure expose m.
parse arg m
    if m.m.catIx >= 0 then
        call err 'catWriteAll('m',' arg(2)',' arg(3)') but opened,',
                 'catIx='m.m.catIx
    bx = m.m.RWs.0
    if m.m.catWr ^== '' then do
        call jClose m.m.catWr
        bx=bx+1
        m.m.opts.bx = ""
        m.m.RWs.bx = m.m.catWr
        m.m.catWr = ''
        end
    do ax=2 by 2 to arg()
        bx=bx+1
        m.m.opts.bx = catOpt(arg(ax))
        m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
        call oSetTypePara m, oGetTypePara(m.m.RWs.bx)
        end
    m.m.RWs.0 = bx
    return
endProcedure catWriteAll

/*--- store the list toClose to close them when closing cat ----------*/
catLazyClose: procedure expose m.
parse arg m, toClose
    if m.m.catIx <> -7 then
        call err 'catLazyClose with catIx' m.m.catIx
    if m.m.RWs.0 = 0 then
        return 0
    if m.m.catToClose ^== '' then
        call err 'catLazyClose with catToClose' m.m.catToClose
    if m.m.catIx <> -7 | m.m.catToClose ^== '' then
        m.m.catToClose = toClose
    return 1
endProcedure catLazyClose

catSetTypePara: procedure expose m.
parse arg m, type
    do ix=1 to m.m.RWs.0
        call oSetTypePara m.m.RWs.ix, type
        end
    return
endProcedure catSetTypePara

/*--- create a reader/writer for a dsn -------------------------------*/
catDsn: procedure expose m.
parse arg spec
    m = oNew('CatDsn')
    m.m.readIx = 'c'
    ix = mInc('CAT.BUF')
    m.m.defDD = 'CAT'ix
    m.m.buf = 'CAT.BUF'ix
    call catDsnReset m, spec
    return m
endProcedure catDsn

catDsnReset: procedure expose m.
parse arg m, sp
    if symbol('m.m.defDD') ^== 'VAR' then
        m.m.defDD = 'CDD' mInc('CAT.DEFDD')
    m.m.spec = sp
    return m
endProcedure catDsnReset

catDsnOpen: procedure expose m.
parse arg m, opt
    call jClose m
    buf = m.m.buf
    if opt == 'r' then do
        aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
        if m.dsnAlloc.dsn <> '' then
            if sysDsn("'"m.dsnAlloc.dsn"'") <> 'OK' then
                call err 'cannot read' m.dsnAlloc.dsn':',
                               sysDsn("'"m.dsnAlloc.dsn"'")
        call readDDBegin word(aa, 1)
        m.m.jReading = 1
        m.buf.0 = -1
        m.m.readIx = 0
        end
    else do
        if opt == 'w' then
            aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
        else if opt == 'a' then
            aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
        else
            call err 'catDsnOpen('m',' opt') with bad opt'
        call writeDDbegin word(aa, 1)
        m.m.jWriting = 1
        m.buf.0 = 0
        m.m.readIx = 'w'
        end
    m.m.dd = word(aa, 1)
    m.m.free = subword(aa, 2)
    return m
endProcedure catDsnOpen

catDsnClose:
parse arg m
    buf = m.m.buf
    if m.m.readIx ^== 'c' then do
        if m.m.readIx == 'w' then do
            if m.buf.0 > 0 then
                call writeDD m.m.dd, 'M.'BUF'.'
            call writeDDend m.m.dd
            end
        else do
            call readDDend m.m.dd
            end
        interpret m.m.free
        end
    m.buf.0 = 'closed'
    m.m.readIx = 'c'
    m.m.free  = ''
    m.m.dd    = ''
    return m
endProcedure catDsnClose

catDsnRead: procedure expose m.
parse arg m, var
    ix = m.m.readIx + 1
    buf = m.m.buf
    if ix > m.buf.0 then do
        res = readDD(m.m.dd, 'M.'buf'.')
        if ^ res then
            return 0
        ix = 1
        end
    m.m.readIx = ix
    m.var = m.buf.ix
    return 1
endProcedure catDsnRead

catDsnWrite: procedure expose m.
parse arg m, var
    buf = m.m.buf
    ix = m.buf.0 + 1
    m.buf.0 = ix
    m.buf.ix = var
    if ix > 99 then do
        call writeDD m.m.dd, 'M.'buf'.'
        m.buf.0 = 0
        end
    return
endProcedure catDsnWrite

catIni: procedure expose m.
    if m.cat.ini == 1 then
        return
    m.cat.ini = 1
    m.cat.buf = 0
    call jIni
    call oDecMethods oNewClass("Cat", "JRW"),
        , "jOpen  return catOpen(m, arg)",
        , "jReset return catReset(m, '', arg)",
        , "jClose call catClose m",
        , "jWriteAll call err 'jWriteAll not opened w",
        , "oSetTypePara call catSetTypePara m, type",
        , "jRead return catRead(m, var)",
        , "jWrite call catWrite m, line; return",
        , "jWriteAll call catWriteAll m, opt, rdr; return"
    call oDecMethods oNewClass("CatDsn", "JRW"),
        , "jOpen  return catDsnOpen(m, arg)",
        , "jReset return catDsnReset(m, arg)",
        , "jClose call catDsnClose m",
        , "jRead return catDsnRead(m, var)",
        , "jWrite call catDsnWrite m, line"
    return
endProcedure catIni
/* copy cat  end   ****************************************************/