path: root/ipl/procs/conffile.icn

#############################################################################
#
#       File:     conffile.icn
#
#       Subject:  Procedures to read initialization directives
#
#       Author:   David A. Gamey
#
#       Date:     March 25, 2002
#
#############################################################################
#                 
#       Thanks to Clint Jeffery for suggesting the Directive wrapper and
#       making defining a specification much cleaner looking and easier!
#
#############################################################################
#
#   This file is in the public domain.
#
#############################################################################
#
#   Description:
#
#      At Some point certain procedures become indispensable.  Anyone who
#      has used 'options' from the Icon program library will probably agree.
#      I found a need to be able to quickly, change the format and
#      interpretation of a set of configuration and rules files.  And so, I 
#      hope this collection of procedures will become similarly indispensable. 
#
#
#   Directive( p1, p2, i1, i2 ) : r1
#
#      returns a specification record for a table required by ReadDirectives
#
#      p1 is the build procedure used to extract the data from the file.
#         The table below describes the build procedures and the default
#         minimum and maximum number of arguments for each.  If the included
#         procedures don't meet your needs then you can easily add your own
#         and still use Directive to build the specification.
#
#            build procedure              minargs     maxargs
#
#            Directive_table_of_sets         2            -     
#            Directive_table                 2            -
#            Directive_value                 1            1
#            Directive_set                   1            -
#            Directive_list                  1            -
#            < user defined >                1            -
#            Directive_exists                0            0
#            Directive_ignore                0            -
#            Directive_warning               0            -
#            
#      p2 is an edit procedure that allows you to preprocess the data or null
#      i1 is the minimum number of arguments for this directive, default is 1
#      i2 is the maximum number of arguments for this directive
#
#      Run-time Errors:
#      - 123 if p1 isn't a procedure
#      - 123 if p2 isn't null or a procedure
#      - 101 if i1, i2 aren't integers and not ( 0 <= i1 <= i2 ) after defaults
#
#
#   ReadDirectives( l1, t1, s1, s2, c1, c2, p1 ) : t2
#
#      returns a table containing parsed directives for the specified file
#
#      l1 is a list of file names or open files, each element of l1 is tried 
#         in turn until a file is opened or an open file is encountered.
#
#            For example: [ "my/rules", "/etc/rules", &input ]
#
#      t1 is a table of specifications for parsing and handling each directive
#      s1 the comment character, default "#"
#      s2 the continuation character, default "_"
#      c1 the escape character, default "\"
#      c2 the cset of whitespace, default ' \b\t\v\f\r'	
#      p1 stop | an error procedure to be called, fail if null
#
#      t2 is a table containing the parsed results keyed by tag
#
#      Notes:
#         - the special key "*file*" is a list containing the original 
#           text of input file with interspersed diagnostic messages. 
#         - the comment, escape, continuation and whitespace characters 
#           must not overlap (unpredictable)
#         - the end of a directive statement will forcibly close an open 
#           quote (no warning)
#         - the end of file will forcibly close a continuation (no warning)
#
#      Run-time Errors: 
#         - 103, 104, 107, 108, 500
#           500 errors occur if:
#           - arguments are too big/small
#           - the specification table is improper    
#
#   Directive file syntax:
#
#      - blank lines are ignored
#      - all syntactic characters are parameterized
#      - everything after a comment character is ignored (discarded)
#      - to include a comment character in the directive, 
#        precede it with an escape 
#      - to continue a directive, 
#        place a continue character at the end of the line (before comments)
#      - trailing whitespace is NOT ignored in continuations
#      - quoted strings are supported, 
#      - to include a quote within a quoted string,  
#        precede the enclosed quote with an escape
#
#   Usage:
#
#   -- Config file, example: --
#
#      # comment line
#
#      var1 "This string, w/o quotes, will be in cfgspec[\"var\"]"
#      cset1 "abcdefffffffffffff"   # type of quotes isn't important
#      int1  12345
#      lcase1 "Hello There THIs iS CasE inSENsITive"
#      list1 one two three _ # continues
#           four five one three zero 
#      set1 one one one two three 3 'a b c' # one two three 3 'a b c'
#      table1 k1 v1
#      table1 k2 v2
#      t/set1 key1 v1 v2 v3 v4
#      t/set1 key2 v5 v6
#      t/set1 key3 "1 2 \#3"  # comment
#      warn1  this will produce _
#             a warning 
#
#   -- Coding example: --
#
#      # 1. Define a specification table using Directive.
#      #    Directive has four fields:
#      #    - the procedure to handle the tag
#      #    - an optional edit procedure to preprocess the data 
#      #    - the minimum number of values following the tag, 
#      #      default is dependent on the &null is treated as 0 
#      #    - the maximum number of values following the tag,
#      #      &null is treated as unlimited 
#      #    The table's keys are the directives of the configuration file 
#      #    The default specification should be either warning of ignore
#
#           cfgspec    := table( Directive( Directive_warning ) )
#           cfgspec["var1"]   := Directive( Directive_value )
#           cfgspec["cset1"]  := Directive( Directive_value, cset )
#           cfgspec["int1"]   := Directive( Directive_value, integer )
#           cfgspec["lcase1"] := Directive( Directive_value, map )
#           cfgspec["list1"]  := Directive( Directive_list )
#           cfgspec["set1"]   := Directive( Directive_set )
#           cfgspec["table1"] := Directive( Directive_table )
#           cfgspec["t/set1"] := Directive( Directive_table_of_sets )
#
#      # 2. Read, parse and build a table based upon the spec and the file
#
#           cfg := ReadDirectives( ["my.conf",&input], cfgspec )
#
#      # 3. Process the output 
#
#           write("Input:\n")
#           every write(!cfg["*file*"])
#           write("\nBuilt:\n")
#           every  k :=key(cfg) do 
#           if k ~== "*file*" then write(k, " := ",ximage(cfg[k]))
#
#   -- Output: --
#
#      Input:
#
#      # comment line
#
#      var1 "This string, w/o quotes, will be in cfgspec[\"var\"]"
#      cset1 "abcdefffffffffffff"   # type of quotes isn't important
#      int1  12345
#      lcase1 "Hello There THIs iS CasE inSENsITive"
#      list1 one two three _ # continues
#          four five one three zero 
#      set1 one one one two three 3 'a b c' # one two three 3 'a b c'
#            table1 k1 v1
#            table1 k2 v2
#            t/set1 key1 v1 v2 v3 v4
#            t/set1 key2 v5 v6
#            t/set1 key3 "1 2 \#3"  # comment
#      warn This will produce a _
#           warning
#      -- Directive isn't defined in specification.
#
#      Built:
#
#      set1 := S1 := set()
#         insert(S1,"3")
#         insert(S1,"a b c")
#         insert(S1,"one")
#         insert(S1,"three")
#         insert(S1,"two")
#      cset1 := 'abcdef'
#      t/set1 := T4 := table(&null)
#         T4["key1"] := S2 := set()
#            insert(S2,"v1")
#            insert(S2,"v2")
#            insert(S2,"v3")
#            insert(S2,"v4")
#         T4["key2"] := S3 := set()
#            insert(S3,"v5")
#            insert(S3,"v6")
#         T4["key3"] := S4 := set()
#            insert(S4,"1 2 #3")
#      list1 := L12 := list(8)
#         L12[1] := "one"
#         L12[2] := "two"
#         L12[3] := "three"
#         L12[4] := "four"
#         L12[5] := "five"
#         L12[6] := "one"
#         L12[7] := "three"
#         L12[8] := "zero"
#      lcase1 := "hello there this is case insensitive"
#      int1 := 12345
#      var1 := "This string, w/o quotes, will be in cfgspec[\"var\"]"
#      table1 := T3 := table(&null)
#         T3["k1"] := "v1"
#         T3["k2"] := "v2"
#
#############################################################################

link lastc

record _DirectivesSpec_(classproc,editproc,minargs,maxargs)


procedure Directive(p,e,mi,mx)    #: Wrapper to build directive specification

if type(p) ~== "procedure" then runerr(123,p)
if type(\e) ~== "procedure" then runerr(123,e) else /e := 1

case p of 
{
   Directive_table | Directive_table_of_sets:  /mi := 2
   Directive_value  :  { /mi := 1 ; /mx := 1 }
   Directive_exists :  { /mi := 0 ; /mx := 0 }
   default          :  /mi := 1
}

if not ( integer(mi) >= 0 ) then runerr(101,mi)
if \mx & not ( integer(mx) >= mi ) then runerr(101,mx)

return _DirectivesSpec_(p,e,mi,mx)
end


procedure ReadDirectives( #: Builds icon data structures from a config file
             fnL,spec,comment,continue,escape,quotes,whitespace,errp)

local notescape, eof, line, wip, x, y, q, s, d
local sL, sLL, f, fn, fL, action, tag, DirectiveT

#   1. defaults, type checking and setup

/comment    := "#"
/continue   := "_"
/escape     := '\\'
/quotes     := '\'"'
/whitespace := ' \b\t\v\f\r'

if not ( comment := string(comment) ) then runerr(103,comment)
if *comment ~= 1 then runerr(500,comment)

if not ( continue := string(continue) ) then runerr(103,continue)
if *continue ~= 1 then runerr(500,continue)

if not ( escape := cset(escape) ) then runerr(104,escape)
if *escape ~= 1 then runerr(500,escape)
notescape := ~escape

if not ( quotes := cset(quotes) ) then runerr(104,quotes)
if *quotes = 0 then runerr(500,quotes)

if not ( whitespace :=  cset(whitespace) ) then runerr(104,whitespace)
if *whitespace = 0 then runerr(500,whitespace)

if type(fnL) ~== "list" then runerr(108,fnL)

if type(spec) ~== "table" then runerr(124,spec)

fL := []                 # list of original config file
sL := []                 # list of lists corresponding to each directive
DirectiveT := table()    # results

#   2. locate (and open) a file

every fn := !fnL do
{
   if /fn then next
   if type(fn) == "file" then break f := fn
   if f := open(fn) then break
}
if /f then
{
   write(&errout,"ReadDirectives: no open(able) files in: ",every image(!fnL) )
   \errp() | fail
}

#   3. input, tokenizing and processing of directives 

while /eof do 
{

   #  3.1 gather complete directive statements

   wip := ""
   repeat 
   {
      if not ( line := read(f) ) then eof := line := ""
      else
      {
         put(fL,line)                                  # save original line
         line ?:=  2( tab(many(whitespace)), tab(0) )  # discard leading w/s 
         line ?:=  tab(findp(notescape,comment))       # discard comment 
         line := trim(line,whitespace)
      }
      wip ||:= line
      if wip[-1] == continue then 
      {
         wip := wip[1:-1]
         next
      }
      else break
   }

   #  3.2 tokenize directive

   put( sL, sLL := [] )                   # start a list of words
   wip ? repeat 
   {
      tab( many(whitespace) )             # kill leading white space
      if pos(0) then break                # deal with trailing whitespace here

      ( q := tab(any(quotes)), 
        ( x := 1( tab(findp(notescape,q)), =q ) | tab(0) ) 
      ) | ( x := tab(upto(whitespace) | 0) )  

      y := ""
      x ?                                 # strip imbedded escape characters
      { 
         while y ||:= tab(upto(escape)) do move(1)
         y ||:= tab(0)
      }
      put( sLL, y )                       # save token 
   }

   if *sLL = 0 then                       # remove and skip null lines
      pull(sL) & next
  
   #  3.3 process directive
 
   action :=  get(sLL)                    # peel off the action tag
   d := spec[action]

   if /d | /d.classproc then runerr(500,d)

   if *sLL <  \d.minargs then put( fL, "-- Fewer arguments than spec allows.")
   if *sLL >  \d.maxargs then put( fL, "-- More arguments than spec allows.")

   (d.classproc)(fL,DirectiveT,action,sLL,d.editproc) # call build procedure
}

DirectiveT["*file*"] := fL                     # save original text
return DirectiveT
end

#  Build support procedures

procedure Directive_table_of_sets( #: build table of sets: action key value(s)
          fileL,DirectiveT,action,argL,editproc)
local tag

if *argL < 2 then 
   put(fileL,"-- Too few arguments for (table_of_sets): action key value(s)") 
/DirectiveT[action] := table() 
/DirectiveT[action][tag := get(argL) ] := set()
while insert(DirectiveT[action][tag],editproc(get(argL)) )
return
end
 
         
procedure Directive_table( #: build table: action key value
          fileL,DirectiveT,action,argL,editproc)

if *argL ~= 2 then 
   put(fileL,"-- Wrong number of arguments for (table): action key value") 
/DirectiveT[action] := table()
DirectiveT[action][get(argL)] := editproc(get(argL)) 
return
end

         
procedure Directive_set( #: build set: action value(s)
          fileL,DirectiveT,action,argL,editproc)

if *argL < 1 then 
   put(fileL,"-- Too few arguments for (set): action value(s)") 
/DirectiveT[action] := set()
while insert( DirectiveT[action], editproc(get(argL)) )
return
end

         
procedure Directive_list( #: build list: action value(s)
          fileL,DirectiveT,action,argL,editproc)

if *argL < 1 then 
   put(fileL,"-- Too few arguments for (list): action value(s)") 
/DirectiveT[action] := [] 
while put( DirectiveT[action], editproc(get(argL)) )
return
end


procedure Directive_value( #: build value: action value
          fileL,DirectiveT,action,argL,editproc)

if *argL = 0 then 
   DirectiveT[action] := &null 
else 
   DirectiveT[action] := editproc(get(argL)) 
return
end

procedure Directive_exists( #: build existence flag: action
          fileL,DirectiveT,action,argL,editproc)

if *argL = 0 then 
   DirectiveT[action] := 1
else 
   DirectiveT[action] := editproc(get(argL)) 
return
end


procedure Directive_ignore( #: quietly ignore any directive
          fileL,DirectiveT,action,argL,editproc)

return
end

         
procedure Directive_warning( #: flag directive with a warning
          fileL,DirectiveT,action,argL,editproc)

put(fileL,"-- Directive isn't defined in specification." )
return
end