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

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.