Return to delam.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / ipl / source

Annotation of researchv10dc/cmd/icon/ipl/source/delam.icn, revision 1.1

1.1     ! root        1: #      DELAM
        !             2: #
        !             3: #      Delaminate file using field list
        !             4: #
        !             5: #      Thomas R. Hicks
        !             6: #
        !             7: #      Last modified 1/19/86 by Ralph E. Griswold
        !             8: #
        !             9: 
        !            10: procedure main(a)
        !            11:    local fylist, ranges
        !            12:    if any('0123456789',a[1]) then
        !            13:       ranges := fldecode(a[1])
        !            14:    else
        !            15:       {
        !            16:       write(&errout,"Bad argument to delam: ",a[1])
        !            17:       Usage()
        !            18:       }
        !            19:    if not a[2] then
        !            20:       Usage()
        !            21:    fylist := doutfyls(a,2)
        !            22:    if *fylist ~= *ranges then
        !            23:       stop("Unequal number of field args and output files")
        !            24:    delamr(ranges,fylist)
        !            25: end
        !            26: 
        !            27: # Usage - write usage message
        !            28: #
        !            29: procedure Usage()
        !            30:    stop("Usage: delam fieldlist {outputfile | -} ...")
        !            31: end
        !            32: 
        !            33: # delamr - do actual division of input file
        !            34: #
        !            35: procedure delamr(ranges,fylist)
        !            36:    local i, j, k, line
        !            37:    while line := read() do
        !            38:       {
        !            39:       i := 1
        !            40:       while i <= *fylist do
        !            41:          {
        !            42:          j := ranges[i][1]
        !            43:          k := ranges[i][2]
        !            44:          if k > 0 then
        !            45:             write(fylist[i][2],line[j+:k] | line[j:0] | "")
        !            46:          i +:= 1
        !            47:          }
        !            48:       }
        !            49: end
        !            50: 
        !            51: # doutfyls - process the output file arguments; return list
        !            52: #
        !            53: procedure doutfyls(a,i)
        !            54:    local lst, x
        !            55:    lst := []
        !            56:    while \a[i] do
        !            57:       {
        !            58:       if x := llu(a[i],lst) then               # already in list
        !            59:          lst |||:= [[a[i],lst[x][2]]]
        !            60:       else                                     # not in list
        !            61:          if a[i] == "-" then                   # standard out
        !            62:             lst |||:= [[a[i],&output]]
        !            63:          else                                  # new file
        !            64:             if not (x := open(a[i],"w")) then
        !            65:                stop("Cannot open ",a[i]," for output")
        !            66:             else
        !            67:                lst |||:= [[a[i],x]]
        !            68:       i +:= 1
        !            69:       }
        !            70:    return lst
        !            71: 
        !            72: end
        !            73: 
        !            74: # fldecode - decode the fieldlist argument
        !            75: #
        !            76: procedure fldecode(fldlst)
        !            77:    local fld, flst, poslst, m, n, x
        !            78:    poslst := []
        !            79:    flst := str2lst(fldlst,':,;')
        !            80:    every fld := !flst do
        !            81:       {
        !            82:       if x := upto('-+',fld) then
        !            83:          {
        !            84:          if not (m := integer(fld[1:x])) then
        !            85:             stop("bad argument in field list; ",fld)
        !            86:          if not (n := integer(fld[x+1:0])) then
        !            87:             stop("bad argument in field list; ",fld)
        !            88:          if upto('-',fld) then
        !            89:             {
        !            90:             if n < m then
        !            91:                n := 0
        !            92:             else
        !            93:                n := (n - m) + 1
        !            94:             }
        !            95:          }
        !            96:       else {
        !            97:          if not (m := integer(fld)) then
        !            98:             stop("bad argument in field list; ",fld)
        !            99:          n := 1
        !           100:          }
        !           101:       poslst |||:= [[m,n]]
        !           102:       }
        !           103:    return poslst
        !           104: end
        !           105: 
        !           106: # llu - lookup file name in output file list
        !           107: #
        !           108: procedure llu(str,lst)
        !           109:    local i
        !           110:    i := 1
        !           111:    while \lst[i] do
        !           112:       {
        !           113:       if \lst[i][1] == str then
        !           114:          return i
        !           115:       i +:= 1
        !           116:       }
        !           117: end
        !           118: 
        !           119: # str2lst - create a list from a delimited string
        !           120: #
        !           121: procedure str2lst(str,delim)
        !           122:    local lst, f
        !           123:    lst := []
        !           124:    str ? {
        !           125:       while f := (tab(upto(delim))) do
        !           126:       {
        !           127:       lst |||:= [f]
        !           128:       move(1)
        !           129:       }
        !           130:         if "" ~== (f := tab(0)) then
        !           131:         lst |||:= [f]
        !           132:         }
        !           133:    return lst
        !           134: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.