#############################################################################
#
# File: conffile.icn
#
# Subject: Procedures to read initialization directives
#
# Author: David A. Gamey
#
# Date: May 3, 2001
#
#############################################################################
#
# 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 dependant 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
This page produced by UniDoc on 2021/04/15 @ 23:59:45.