diff options
Diffstat (limited to 'ipl/procs/conffile.icn')
| -rw-r--r-- | ipl/procs/conffile.icn | 452 |
1 files changed, 452 insertions, 0 deletions
diff --git a/ipl/procs/conffile.icn b/ipl/procs/conffile.icn new file mode 100644 index 0000000..670aef5 --- /dev/null +++ b/ipl/procs/conffile.icn @@ -0,0 +1,452 @@ +############################################################################# +# +# 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 |