############################################################################# # # 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