Return to delam.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

Annotation of 43BSD/contrib/icon/src/cmd/delam.icn, revision 1.1.1.1

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

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