1package Config::Grammar;
2use strict;
3
4$Config::Grammar::VERSION = '1.10';
5
6sub new($$)
7{
8    my $proto   = shift;
9    my $grammar = shift;
10    my $class   = ref($proto) || $proto;
11
12    my $self = {grammar => $grammar};
13    bless($self, $class);
14    return $self;
15}
16
17sub err($)
18{
19    my $self = shift;
20    return $self->{'err'};
21}
22
23sub _make_error($$)
24{
25    my $self = shift;
26    my $text = shift;
27    $self->{'err'} = "$self->{file}, line $self->{line}: $text";
28}
29
30sub _peek($)
31{
32    my $a = shift;
33    return $a->[$#$a];
34}
35
36sub _quotesplit($)
37{
38    my $line = shift;
39    my @items;
40    while ($line ne "") {
41        if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) {
42            my $frag = $1;
43            $frag =~ s/\\(.)/$1/g;
44            push @items, $frag;
45        } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) {
46            my $frag = $1;
47            $frag =~ s/\\(.)/$1/g;
48            push @items, $frag;
49        }
50        elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) {
51            my $frag = $1;
52            $frag =~ s/\\(.)/$1/g;
53            push @items, $frag;
54        }
55        else {
56            die "Internal parser error for '$line'";
57        }
58    }
59    return @items;
60}
61
62sub _check_mandatory($$$$)
63{
64    my $self    = shift;
65    my $g       = shift;
66    my $c       = shift;
67    my $section = shift;
68
69    # check _mandatory sections, variables and tables
70    if (defined $g->{_mandatory}) {
71        for (@{$g->{_mandatory}}) {
72            if (not defined $g->{$_}) {
73                $g->{$_} = {};
74            }
75            if (not defined $c->{$_}) {
76                if (defined $section) {
77                    $self->{'err'} .= "$self->{file} ($section): ";
78                }
79                else {
80                    $self->{'err'} = "$self->{file}: ";
81                }
82
83                if (defined $g->{$_}{_is_section}) {
84                    $self->{'err'} .= "mandatory (sub)section '$_' not defined";
85                }
86                elsif ($_ eq '_table') {
87                    $self->{'err'} .= "mandatory table not defined";
88                }
89                else {
90                    $self->{'err'} .= "mandatory variable '$_' not defined";
91                }
92                return 0;
93            }
94        }
95    }
96
97    for (keys %$c) {
98
99        # do some cleanup
100        ref $c->{$_} eq 'HASH' or next;
101        defined $c->{$_}{_is_section} or next;
102        $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_},
103          defined $section ? "$section/$_" : "$_") or return 0;
104        delete $c->{$_}{_is_section};
105        delete $c->{$_}{_grammar};
106        delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count};
107    }
108
109    return 1;
110}
111
112######### SECTIONS #########
113
114# search grammar definition of a section
115sub _search_section($$)
116{
117    my $self = shift;
118    my $name = shift;
119
120    if (not defined $self->{grammar}{_sections}) {
121        $self->_make_error("no sections are allowed");
122        return undef;
123    }
124
125    # search exact match
126    for (@{$self->{grammar}{_sections}}) {
127        if ($name eq $_) {
128            return $_;
129        }
130    }
131
132    # search regular expression
133    for (@{$self->{grammar}{_sections}}) {
134        if (m|^/(.*)/$|) {
135            if ($name =~ /^$1$/) {
136                return $_;
137            }
138        }
139    }
140
141    # no match
142    $self->_make_error("unknown section '$name'");
143    return undef;
144}
145
146# fill in default values for this section
147sub _fill_defaults ($) {
148    my $self = shift;
149    my $g = $self->{grammar};
150    my $c = $self->{cfg};
151    if ($g->{_vars}) {
152        for my $var (@{$g->{_vars}}) {
153                next if exists $c->{$var};
154                my $value = $g->{$var}{_default}
155                  if exists $g->{$var}{_default};
156                next unless defined $value;
157                $c->{$var} = $value;
158        }
159    }
160
161}
162
163sub _next_level($$$)
164{
165    my $self = shift;
166    my $name = shift;
167
168    # section name
169    if (defined $self->{section}) {
170        $self->{section} .= "/$name";
171    }
172    else {
173        $self->{section} = $name;
174    }
175
176    # grammar context
177    my $s = $self->_search_section($name);
178    return 0 unless defined $s;
179    if (not defined $self->{grammar}{$s}) {
180        $self->_make_error("Config::Grammar internal error (no grammar for $s)");
181        return 0;
182    }
183    push @{$self->{grammar_stack}}, $self->{grammar};
184    $self->{grammar} = $self->{grammar}{$s};
185
186    # support for inherited values
187    # note that we have to do this on the way down
188    # and keep track of which values were inherited
189    # so that we can propagate the values even further
190    # down if needed
191    my %inherited;
192    if ($self->{grammar}{_inherited}) {
193        for my $var (@{$self->{grammar}{_inherited}}) {
194                next unless exists $self->{cfg}{$var};
195                my $value = $self->{cfg}{$var};
196                next unless defined $value;
197                next if ref $value; # it's a section
198                $inherited{$var} = $value;
199        }
200    }
201
202    # config context
203    my $order;
204    if (defined $self->{grammar}{_order}) {
205        if (defined $self->{cfg}{_order_count}) {
206            $order = ++$self->{cfg}{_order_count};
207        }
208        else {
209            $order = $self->{cfg}{_order_count} = 0;
210        }
211    }
212
213    if (defined $self->{cfg}{$name}) {
214        $self->_make_error('section or variable already exists');
215        return 0;
216    }
217    $self->{cfg}{$name} = { %inherited }; # inherit the values
218    push @{$self->{cfg_stack}}, $self->{cfg};
219    $self->{cfg} = $self->{cfg}{$name};
220
221    # keep track of the inherited values here;
222    # we delete it on the way up in _prev_level()
223    $self->{cfg}{_inherited} = \%inherited;
224
225    # list of already defined variables on this level
226    if (defined $self->{grammar}{_varlist}) {
227	$self->{cfg}{_varlist} = [];
228    }
229
230    # meta data for _mandatory test
231    $self->{grammar}{_is_section} = 1;
232    $self->{cfg}{_is_section}     = 1;
233    $self->{cfg}{_grammar}        = $s;
234    $self->{cfg}{_order} = $order if defined $order;
235
236    # increase level
237    $self->{level}++;
238
239    return 1;
240}
241
242sub _prev_level($)
243{
244    my $self = shift;
245
246    # fill in the values from _default keywords when going up
247    $self->_fill_defaults;
248
249    # section name
250    if (defined $self->{section}) {
251        if ($self->{section} =~ /\//) {
252            $self->{section} =~ s/\/.*?$//;
253        }
254        else {
255            $self->{section} = undef;
256        }
257    }
258
259    # clean up the _inherited hash, we won't need it anymore
260    delete $self->{cfg}{_inherited};
261
262    # config context
263    $self->{cfg} = pop @{$self->{cfg_stack}};
264
265    # grammar context
266    $self->{grammar} = pop @{$self->{grammar_stack}};
267
268    # decrease level
269    $self->{level}--;
270}
271
272sub _goto_level($$$)
273{
274    my $self  = shift;
275    my $level = shift;
276    my $name  = shift;
277
278    # _text is multi-line. Check when changing level
279    $self->_check_text($self->{section}) or return 0;
280
281    if ($level > $self->{level}) {
282        if ($level > $self->{level} + 1) {
283            $self->_make_error("section nesting error");
284            return 0;
285        }
286        $self->_next_level($name) or return 0;
287    }
288    else {
289
290        while ($self->{level} > $level) {
291            $self->_prev_level;
292        }
293        if ($level != 0) {
294            $self->_prev_level;
295            $self->_next_level($name) or return 0;
296        }
297    }
298
299    return 1;
300}
301
302######### VARIABLES #########
303
304# search grammar definition of a variable
305sub _search_variable($$)
306{
307    my $self = shift;
308    my $name = shift;
309
310    if (not defined $self->{grammar}{_vars}) {
311        $self->_make_error("no variables are allowed");
312        return undef;
313    }
314
315    # search exact match
316    for (@{$self->{grammar}{_vars}}) {
317        if ($name eq $_) {
318            return $_;
319        }
320    }
321
322    # search regular expression
323    for (@{$self->{grammar}{_vars}}) {
324        if (m|^/(.*)/$|) {
325            if ($name =~ /^$1$/) {
326                return $_;
327            }
328        }
329    }
330
331    # no match
332    $self->_make_error("unknown variable '$name'");
333    return undef;
334}
335
336sub _set_variable($$$)
337{
338    my $self  = shift;
339    my $key   = shift;
340    my $value = shift;
341
342    my $gn = $self->_search_variable($key);
343    defined $gn or return 0;
344
345    my $varlistref;
346    if (defined $self->{grammar}{_varlist}) {
347	$varlistref = $self->{cfg}{_varlist};
348    }
349
350    if (defined $self->{grammar}{$gn}) {
351        my $g = $self->{grammar}{$gn};
352
353        # check regular expression
354        if (defined $g->{_re}) {
355            $value =~ /^$g->{_re}$/ or do {
356                if (defined $g->{_re_error}) {
357                    $self->_make_error($g->{_re_error});
358                }
359                else {
360                    $self->_make_error("syntax error in value of '$key'");
361                }
362                return 0;
363              }
364        }
365        if (defined $g->{_sub}){
366                my $error = &{$g->{_sub}}($value, $varlistref);
367                if (defined $error){
368                        $self->_make_error($error);
369                        return 0;
370                }
371        }
372    }
373    $self->{cfg}{$key} = $value;
374    push @{$varlistref}, $key if ref $varlistref;
375
376    return 1;
377}
378
379######### PARSER #########
380
381sub _parse_table($$)
382{
383    my $self = shift;
384    local $_ = shift;
385
386    my $g = $self->{grammar}{_table};
387    defined $g or do {
388        $self->_make_error("table syntax error");
389        return 0;
390    };
391
392    my @l = _quotesplit $_;
393
394    # check number of columns
395    my $columns = $g->{_columns};
396    if (defined $columns and $#l + 1 != $columns) {
397        $self->_make_error("row must have $columns columns (has " . ($#l + 1)
398          . ")");
399        return 0;
400    }
401
402    # check columns
403    my $n = 0;
404    for my $c (@l) {
405        my $gc = $g->{$n};
406        defined $gc or next;
407
408        # regular expression
409        if (defined $gc->{_re}) {
410            $c =~ /^$gc->{_re}$/ or do {
411                if (defined $gc->{_re_error}) {
412                    $self->_make_error("column ".($n+1).": $gc->{_re_error}");
413                }
414                else {
415                    $self->_make_error("syntax error in column ".($n+1));
416                }
417                return 0;
418            };
419        }
420        if (defined $gc->{_sub}){
421                my $error = &{$gc->{_sub}}($c);
422                if (defined $error) {
423                        $self->_make_error($error);
424                        return 0;
425                }
426        }
427        $n++;
428    }
429
430    # hash (keyed table)
431    if (defined $g->{_key}) {
432        my $kn = $g->{_key};
433        if ($kn < 0 or $kn > $#l) {
434            $self->_make_error("grammar error: key out of bounds");
435        }
436        my $k = $l[$kn];
437
438        if (defined $self->{cfg}{$k}) {
439            $self->_make_error("table row $k already defined");
440            return 0;
441        }
442        $self->{cfg}{$k} = \@l;
443    }
444
445    # list (unkeyed table)
446    else {
447        push @{$self->{cfg}{_table}}, \@l;
448    }
449
450    return 1;
451}
452
453sub _parse_text($$)
454{
455    my ($self, $line) = @_;
456
457    $self->{cfg}{_text} .= $line;
458
459    return 1;
460}
461
462sub _check_text($$)
463{
464    my ($self, $name) = @_;
465
466    my $g = $self->{grammar}{_text};
467    defined $g or return 1;
468
469    # chop empty lines at beginning and end
470    if(defined $self->{cfg}{_text}) {
471	$self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m;
472	$self->{cfg}{_text} =~  s/^([ \t]*[\n\r]+)*\Z//m;
473    }
474
475    if (defined $g->{_re}) {
476        $self->{cfg}{_text} =~ /^$g->{_re}$/ or do {
477            if (defined $g->{_re_error}) {
478                $self->_make_error($g->{_re_error});
479            }
480            else {
481                $self->_make_error("syntax error");
482            }
483            return 0;
484          }
485    }
486    if (defined $g->{_sub}){
487        my $error =  &{$g->{_sub}}($self->{cfg}{_text});
488        if (defined $error) {
489            $self->_make_error($error);
490            return 0;
491        }
492    }
493    return 1;
494}
495
496sub _parse_file($$);
497
498sub _parse_line($$$)
499{
500    my $self = shift;
501    local $_ = shift;
502    my $source = shift;
503
504    /^\@include\s+["']?(.*)["']?$/ and do {
505	my $inc = $1;
506        if ( ( $^O eq 'win32' and $inc !~ m|^(?:[a-z]:)?[/\\]|i and  $self->{file} =~ m|^(.+)[\\/][^/]+$| ) or
507	     ( $inc !~ m|^/| and $self->{file} =~ m|^(.+)/[^/]+$| ) ){
508	   $inc = "$1/$inc";
509        }
510        push @{$self->{file_stack}}, $self->{file};
511        push @{$self->{line_stack}}, $self->{line};
512        $self->_parse_file($inc) or return 0;
513        $self->{file} = pop @{$self->{file_stack}};
514        $self->{line} = pop @{$self->{line_stack}};
515        return 1;
516    };
517    /^\@define\s+(\S+)\s+(.*)$/ and do {
518	$self->{defines}{$1}=$2;
519	return 1;
520    };
521
522    if(defined $self->{defines}) {
523	for my $d (keys %{$self->{defines}}) {
524	    s/$d/$self->{defines}{$d}/g;
525	}
526    }
527
528    /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do {
529    	my $name = $1;
530        $self->_goto_level(1, $name) or return 0;
531	$self->_check_section_sub($name) or return 0;
532        return 1;
533    };
534    /^(\++)\s*(.*)$/ and do {
535        my $level = length $1;
536    	my $name = $2;
537        $self->_goto_level($level + 1, $name) or return 0;
538	$self->_check_section_sub($name) or return 0;
539        return 1;
540    };
541
542    if (defined $self->{grammar}{_text}) {
543        $self->_parse_text($source) or return 0;
544        return 1;
545    }
546    /^(\S+)\s*=\s*(.*)$/ and do {
547        if (defined $self->{cfg}{$1}) {
548            if (exists $self->{cfg}{_inherited}{$1}) {
549                # it's OK to override any inherited values
550                delete $self->{cfg}{_inherited}{$1};
551                delete $self->{cfg}{$1};
552            } else {
553                $self->_make_error('variable already defined');
554                return 0;
555            }
556        }
557        $self->_set_variable($1, $2) or return 0;
558        return 1;
559    };
560
561    $self->_parse_table($_) or return 0;
562
563    return 1;
564}
565
566sub _check_section_sub($$) {
567	my $self = shift;
568	my $name = shift;
569	my $g = $self->{grammar};
570        if (defined $g->{_sub}){
571                my $error = &{$g->{_sub}}($name);
572                if (defined $error){
573                        $self->_make_error($error);
574                        return 0;
575                }
576        }
577	return 1;
578}
579
580sub _parse_file($$)
581{
582    my $self = shift;
583    my $file = shift;
584
585    local *File;
586    unless ($file) { $self->{'err'} = "no filename given" ;
587                     return undef;};
588    open(File, "$file") or do {
589        $self->{'err'} = "can't open $file: $!";
590        return undef;
591    };
592    $self->{file} = $file;
593
594    local $_;
595    my $source = '';
596    while (<File>) {
597	$source .= $_;
598        chomp;
599        s/^\s+//;
600        s/\s+$//;            # trim
601        s/\s*#.*$//;         # comments
602        next if $_ eq '';    # empty lines
603        while (/\\$/) {# continuation
604            s/\\$//;
605            my $n = <File>;
606            last if not defined $n;
607            chomp $n;
608            $n =~ s/^\s+//;
609            $n =~ s/\s+$//;    # trim
610            $_ .= ' ' . $n;
611        }
612
613        $self->{line} = $.;
614        $self->_parse_line($_, $source) or do{ close File; return 0; };
615	$source = '';
616    }
617    close File;
618    return 1;
619}
620
621sub makepod($) {
622    my $pod = eval {
623	require Config::Grammar::Document;
624	return Config::Grammar::Document::makepod(@_);
625    };
626    defined $pod or die "ERROR: install Config::Grammar::Document in order to use makepod(): $@\n";
627    return $pod;
628}
629
630sub maketmpl ($@) {
631    my $pod = eval {
632	require Config::Grammar::Document;
633	return Config::Grammar::Document::maketmpl(@_);
634    };
635    defined $pod or die "ERROR: install Config::Grammar::Document in order to use maketmpl()\n";
636    return $pod;
637}
638
639sub makemintmpl ($@) {
640    my $pod = eval {
641	require Config::Grammar::Document;
642	return Config::Grammar::Document::makemintmpl(@_);
643    };
644    defined $pod or die "ERROR: install Config::Grammar::Document in order to use makemintmpl()\n";
645    return $pod;
646}
647
648sub parse($$)
649{
650    my $self = shift;
651    my $file = shift;
652
653    $self->{cfg}           = {};
654    $self->{level}         = 0;
655    $self->{cfg_stack}     = [];
656    $self->{grammar_stack} = [];
657    $self->{file_stack}    = [];
658    $self->{line_stack}    = [];
659
660    $self->_parse_file($file) or return undef;
661
662    $self->_goto_level(0, undef) or return undef;
663
664    # fill in the top level values from _default keywords
665    $self->_fill_defaults;
666
667    $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef)
668      or return undef;
669
670    return $self->{cfg};
671
672}
673
6741;
675
676__END__
677
678=head1 NAME
679
680Config::Grammar - A grammar-based, user-friendly config parser
681
682=head1 SYNOPSIS
683
684 use Config::Grammar;
685
686 my $parser = Config::Grammar->new(\%grammar);
687 my $cfg = $parser->parse('app.cfg') or die "ERROR: $parser->{err}\n";
688 my $pod = $parser->makepod();
689 my $ex = $parser->maketmpl('TOP','SubNode');
690 my $minex = $parser->maketmplmin('TOP','SubNode');
691
692=head1 DESCRIPTION
693
694Config::Grammar is a module to parse configuration files. The
695configuration may consist of multiple-level sections with assignments
696and tabular data. The parsed data will be returned as a hash
697containing the whole configuration. Config::Grammar uses a grammar
698that is supplied upon creation of a Config::Grammar object to parse
699the configuration file and return helpful error messages in case of
700syntax errors. Using the B<makepod> method you can generate
701documentation of the configuration file format.
702
703The B<maketmpl> method can generate a template configuration file.  If
704your grammar contains regexp matches, the template will not be all
705that helpful as Config::Grammar is not smart enough to give you sensible
706template data based in regular expressions. The related function
707B<maketmplmin> generates a minimal configuration template without
708examples, regexps or comments and thus allows an experienced user to
709fill in the configuration data more efficiently.
710
711
712=head2 Grammar Definition
713
714The grammar is a multiple-level hash of hashes, which follows the structure of
715the configuration. Each section or variable is represented by a hash with the
716same structure.  Each hash contains special keys starting with an underscore
717such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information
718about that section or variable. Other keys are used to structure the hash
719according to the same nesting structure of the configuration itself. The
720starting hash given as parameter to 'new' contains the "root section".
721
722=head3 Special Section Keys
723
724=over 12
725
726=item _sections
727
728Array containing the list of sub-sections of this section. Each sub-section
729must then be represented by a sub-hash in this hash with the same name of the
730sub-section.
731
732The sub-section can also be a regular expression denoted by the syntax '/re/',
733where re is the regular-expression. In case a regular expression is used, a
734sub-hash named with the same '/re/' must be included in this hash.
735
736=item _vars
737
738Array containing the list of variables (assignments) in this section.
739Analogous to sections, regular expressions can be used.
740
741=item _mandatory
742
743Array containing the list of mandatory sections and variables.
744
745=item _inherited
746
747Array containing the list of the variables that should be assigned the
748same value as in the parent section if nothing is specified here.
749
750=item _table
751
752Hash containing the table grammar (see Special Table Keys). If not specified,
753no table is allowed in this section. The grammar of the columns if specified
754by sub-hashes named with the column number.
755
756=item _text
757
758Section contains free-form text. Only sections and @includes statements will
759be interpreted, the rest will be added in the returned hash under '_text' as
760string.
761
762B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key
763which will be used to scrutanize the text ... if the hash is empty, all text
764will be accepted.
765
766=item _order
767
768If defined, a '_order' element will be put in every hash containing the
769sections with a number that determines the order in which the sections were
770defined.
771
772=item _doc
773
774Describes what this section is about
775
776=item _sub
777
778A function pointer. It is called for every instance of this section,
779with the real name of the section passed as its first argument. This is
780probably only useful for the regexp sections. If the function returns
781a defined value it is assumed that the test was not successful and an
782error is generated with the returned string as content.
783
784=back
785
786=head3 Special Variable Keys
787
788=over 12
789
790=item _re
791
792Regular expression upon which the value will be checked.
793
794=item _re_error
795
796String containing the returned error in case the regular expression doesn't
797match (if not specified, a generic 'syntax error' message will be returned).
798
799=item _sub
800
801A function pointer. It called for every value, with the value passed as its
802first argument. If the function returns a defined value it is assumed that
803the test was not successful and an error is generated with the returned
804string as content.
805
806If the '_varlist' key (see above) is defined in this section, the '_sub'
807function will also receive an array reference as the second argument. The
808array contains a list of those variables already defined in the same
809section. This can be used to enforce the order of the variables.
810
811=item _default
812
813A default value that will be assigned to the variable if none is specified or inherited.
814
815=item _doc
816
817Description of the variable.
818
819=item _example
820
821A one line example for the content of this variable.
822
823=back
824
825=head3 Special Table Keys
826
827=over 12
828
829=item _columns
830
831Number of columns. If not specified, it will not be enforced.
832
833=item _key
834
835If defined, the specified column number will be used as key in a hash in the
836returned hash. If not defined, the returned hash will contain a '_table'
837element with the contents of the table as array. The rows of the tables are
838stored as arrays.
839
840=item _sub
841
842they work analog to the description in the previous section.
843
844=item _doc
845
846describes the content of the column.
847
848=item _example
849
850example for the content of this column
851
852=back
853
854=head3 Special Text Keys
855
856=over 12
857
858=item _re
859
860Regular expression upon which the text will be checked (everything as a single
861line).
862
863=item _re_error
864
865String containing the returned error in case the regular expression doesn't
866match (if not specified, a generic 'syntax error' message will be returned).
867
868=item _sub
869
870they work analog to the description in the previous section.
871
872=item _doc
873
874Ditto.
875
876=item _example
877
878Potential multi line example for the content of this text section
879
880=back
881
882=head2 Configuration Syntax
883
884=head3 General Syntax
885
886'#' denotes a comment up to the end-of-line, empty lines are allowed and space
887at the beginning and end of lines is trimmed.
888
889'\' at the end of the line marks a continued line on the next line. A single
890space will be inserted between the concatenated lines.
891
892'@include filename' is used to include another file. Include works relative to the
893directory where the parent file is in.
894
895'@define a some value' will replace all occurences of 'a' in the following text
896with 'some value'.
897
898Fields in tables that contain white space can be enclosed in either C<'> or C<">.
899Whitespace can also be escaped with C<\>. Quotes inside quotes are allowed but must
900be escaped with a backslash as well.
901
902=head3 Sections
903
904Config::Grammar supports hierarchical configurations through sections, whose
905syntax is as follows:
906
907=over 15
908
909=item Level 1
910
911*** section name ***
912
913=item Level 2
914
915+ section name
916
917=item Level 3
918
919++ section name
920
921=item Level n, n>1
922
923+..+ section name (number of '+' determines level)
924
925=back
926
927=head3 Assignments
928
929Assignements take the form: 'variable = value', where value can be any string
930(can contain whitespaces and special characters). The spaces before and after
931the equal sign are optional.
932
933=head3 Tabular Data
934
935The data is interpreted as one or more columns separated by spaces.
936
937=head2 Example
938
939=head3 Code
940
941 use Data::Dumper;
942 use Config::Grammar;
943
944 my $RE_IP       = '\d+\.\d+\.\d+\.\d+';
945 my $RE_MAC      = '[0-9a-f]{2}(?::[0-9a-f]{2}){5}';
946 my $RE_HOST     = '\S+';
947
948 my $parser = Config::Grammar->new({
949   _sections => [ 'network', 'hosts' ],
950   network => {
951      _vars     => [ 'dns' ],
952      _sections => [ "/$RE_IP/" ],
953      dns       => {
954         _doc => "address of the dns server",
955         _example => "ns1.oetiker.xs",
956         _re => $RE_HOST,
957         _re_error =>
958            'dns must be an host name or ip address',
959         },
960      "/$RE_IP/" => {
961         _doc    => "Ip Adress",
962         _example => '10.2.3.2',
963         _vars   => [ 'netmask', 'gateway' ],
964         netmask => {
965	    _doc => "Netmask",
966	    _example => "255.255.255.0",
967            _re => $RE_IP,
968            _re_error =>
969               'netmask must be a dotted ip address'
970            },
971         gateway => {
972	    _doc => "Default Gateway address in IP notation",
973	    _example => "10.22.12.1",
974            _re => $RE_IP,
975            _re_error =>
976               'gateway must be a dotted ip address' },
977         },
978      },
979   hosts => {
980      _doc => "Details about the hosts",
981      _table  => {
982	  _doc => "Description of all the Hosts",
983         _key => 0,
984         _columns => 3,
985         0 => {
986            _doc => "Ethernet Address",
987            _example => "0:3:3:d:a:3:dd:a:cd",
988            _re => $RE_MAC,
989            _re_error =>
990               'first column must be an ethernet mac address',
991            },
992         1 => {
993            _doc => "IP Address",
994            _example => "10.11.23.1",
995            _re => $RE_IP,
996            _re_error =>
997               'second column must be a dotted ip address',
998            },
999         2 => {
1000            _doc => "Host Name",
1001            _example => "tardis",
1002             },
1003         },
1004      },
1005   });
1006
1007 my $cfg = $parser->parse('test.cfg') or
1008   die "ERROR: $parser->{err}\n";
1009 print Dumper($cfg);
1010 print $parser->makepod;
1011
1012=head3 Configuration
1013
1014 *** network ***
1015
1016   dns      = 192.168.7.87
1017
1018 + 192.168.7.64
1019
1020   netmask  = 255.255.255.192
1021   gateway  = 192.168.7.65
1022
1023 *** hosts ***
1024
1025   00:50:fe:bc:65:11     192.168.7.97    plain.hades
1026   00:50:fe:bc:65:12     192.168.7.98    isg.ee.hades
1027   00:50:fe:bc:65:14     192.168.7.99    isg.ee.hades
1028
1029=head3 Result
1030
1031 {
1032   'hosts' => {
1033                '00:50:fe:bc:65:11' => [
1034                                         '00:50:fe:bc:65:11',
1035                                         '192.168.7.97',
1036                                         'plain.hades'
1037                                       ],
1038                '00:50:fe:bc:65:12' => [
1039                                         '00:50:fe:bc:65:12',
1040                                         '192.168.7.98',
1041                                         'isg.ee.hades'
1042                                       ],
1043                '00:50:fe:bc:65:14' => [
1044                                         '00:50:fe:bc:65:14',
1045                                         '192.168.7.99',
1046                                         'isg.ee.hades'
1047                                       ]
1048              },
1049   'network' => {
1050                  '192.168.7.64' => {
1051                                      'netmask' => '255.255.255.192',
1052                                      'gateway' => '192.168.7.65'
1053                                    },
1054                  'dns' => '192.168.7.87'
1055                }
1056 };
1057
1058=head1 SEE ALSO
1059
1060L<Config::Grammar::Dynamic>
1061
1062=head1 COPYRIGHT
1063
1064Copyright (c) 2000-2005 by ETH Zurich. All rights reserved.
1065Copyright (c) 2007 by David Schweikert. All rights reserved.
1066
1067=head1 LICENSE
1068
1069This program is free software; you can redistribute it and/or modify it
1070under the same terms as Perl itself.
1071
1072=head1 AUTHORS
1073
1074David Schweikert,
1075Tobias Oetiker,
1076Niko Tyni
1077
1078=cut
1079
1080# Emacs Configuration
1081#
1082# Local Variables:
1083# mode: cperl
1084# eval: (cperl-set-style "PerlStyle")
1085# mode: flyspell
1086# mode: flyspell-prog
1087# End:
1088#
1089# vi: sw=4
1090