diff options
Diffstat (limited to 'lib/ISG/ParseConfig.pm')
| -rw-r--r-- | lib/ISG/ParseConfig.pm | 272 |
1 files changed, 245 insertions, 27 deletions
diff --git a/lib/ISG/ParseConfig.pm b/lib/ISG/ParseConfig.pm index 7903972..e578bf8 100644 --- a/lib/ISG/ParseConfig.pm +++ b/lib/ISG/ParseConfig.pm @@ -280,6 +280,11 @@ sub _next_level($$$) # we delete it on the way up in _prev_level() $self->{cfg}{_inherited} = \%inherited; + # list of already defined variables on this level + if (defined $self->{grammar}{_varlist}) { + $self->{cfg}{_varlist} = []; + } + # meta data for _mandatory test $self->{grammar}{_is_section} = 1; $self->{cfg}{_is_section} = 1; @@ -404,6 +409,11 @@ sub _set_variable($$$) my $gn = $self->_search_variable($key); defined $gn or return 0; + my $varlistref; + if (defined $self->{grammar}{_varlist}) { + $varlistref = $self->{cfg}{_varlist}; + } + if (defined $self->{grammar}{$gn}) { my $g = $self->{grammar}{$gn}; @@ -420,7 +430,7 @@ sub _set_variable($$$) } } if (defined $g->{_sub}){ - my $error = &{$g->{_sub}}($value); + my $error = &{$g->{_sub}}($value, $varlistref); if (defined $error){ $self->_make_error($error); return 0; @@ -432,6 +442,8 @@ sub _set_variable($$$) } } $self->{cfg}{$key} = $value; + push @{$varlistref}, $key if ref $varlistref; + return 1; } @@ -586,12 +598,16 @@ sub _parse_line($$$) } /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { - $self->_goto_level(1, $1) or return 0; + my $name = $1; + $self->_check_section_sub($name) or return 0; + $self->_goto_level(1, $name) or return 0; return 1; }; /^(\++)\s*(.*)$/ and do { my $level = length $1; - $self->_goto_level($level + 1, $2) or return 0; + my $name = $2; + $self->_check_section_sub($name) or return 0; + $self->_goto_level($level + 1, $name) or return 0; return 1; }; @@ -619,6 +635,20 @@ sub _parse_line($$$) return 1; } +sub _check_section_sub($$) { + my $self = shift; + my $name = shift; + my $g = $self->{grammar}; + if (defined $g->{_sub}){ + my $error = &{$g->{_sub}}($name); + if (defined $error){ + $self->_make_error($error); + return 0; + } + } + return 1; +} + sub _parse_file($$) { my $self = shift; @@ -661,30 +691,131 @@ sub _parse_file($$) return 1; } +# find variables in old grammar list 'listname' +# that aren't in the corresponding list in the new grammar +# and list them as a POD document, possibly with a callback +# function 'docfunc' + +sub _findmissing($$$;$) { + my $old = shift; + my $new = shift; + my $listname = shift; + my $docfunc = shift; + + my @doc; + if ($old->{$listname}) { + my %newlist; + if ($new->{$listname}) { + @newlist{@{$new->{$listname}}} = undef; + } + for my $v (@{$old->{$listname}}) { + next if exists $newlist{$v}; + if ($docfunc) { + push @doc, &$docfunc($old, $v) + } else { + push @doc, "=item $v"; + } + } + } + return @doc; +} + +# find variables in new grammar list 'listname' +# that aren't in the corresponding list in the new grammar +# +# this is just _findmissing with the arguments swapped + +sub _findnew($$$;$) { + my $old = shift; + my $new = shift; + my $listname = shift; + my $docfunc = shift; + return _findmissing($new, $old, $listname, $docfunc); +} + +# compare two lists for element equality + +sub _listseq($$); +sub _listseq($$) { + my ($k, $l) = @_; + my $length = @$k; + return 0 unless @$l == $length; + for (my $i=0; $i<$length; $i++) { + return 0 unless $k->[$i] eq $l->[$i]; + } + return 1; +} + +# diff two grammar trees, documenting the differences + +sub _diffgrammars($$); +sub _diffgrammars($$) { + my $old = shift; + my $new = shift; + my @doc; + + my @vdoc; + @vdoc = _findmissing($old, $new, '_vars'); + push @doc, "The following variables are not valid anymore:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findnew($old, $new, '_vars', \&_describevar); + push @doc, "The following new variables are valid:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findmissing($old, $new, '_sections'); + push @doc, "The following subsections are not valid anymore:", "=over" , @vdoc, "=back" + if @vdoc; + @vdoc = _findnew($old, $new, '_sections', sub { + my ($tree, $sec) = @_; + my @tdoc; + _genpod($tree->{$sec}, 0, \@tdoc); + return @tdoc; + }); + push @doc, "The following new subsections are defined:", "=over" , @vdoc, "=back" + if @vdoc; + for (@{$old->{_sections}}) { + next unless exists $new->{$_}; + @vdoc = _diffgrammars($old->{$_}, $new->{$_}); + push @doc, "Syntax changes for subsection B<$_>", "=over", @vdoc, "=back" + if @vdoc; + } + return @doc; +} + +# describe a variable + +sub _describevar { + my $tree = shift; + my $var = shift; + my $mandatory = ( $tree->{_mandatory} and + grep {$_ eq $var} @{$tree->{_mandatory}} ) ? + " I<(mandatory setting)>" : ""; + my @doc; + push @doc, "=item B<$var>".$mandatory; + push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; + my $inherited = $tree->{_inherited} and + grep {$_ eq $var} @{$tree->{_inherited}}; + push @doc, "This variable I<inherits> its value from the parent section if nothing is specified here." + if $inherited; + push @doc, "This variable I<dynamically> modifies the grammar based on its value." + if $tree->{$var}{_dyn}; + push @doc, "Default value: $var = $tree->{$var}{_default}" + if ($tree->{$var}{_default}); + push @doc, "Example: $var = $tree->{$var}{_example}" + if ($tree->{$var}{_example}); + return @doc; +} + sub _genpod($$$); sub _genpod($$$){ my $tree = shift; my $level = shift; my $doc = shift; + my %dyndoc; if ($tree->{_vars}){ push @{$doc}, "The following variables can be set in this section:"; push @{$doc}, "=over"; foreach my $var (@{$tree->{_vars}}){ - my $mandatory = ( $tree->{_mandatory} and - grep {$_ eq $var} @{$tree->{_mandatory}} ) ? - " I<(mandatory setting)>" : ""; - push @{$doc}, "=item B<$var>".$mandatory; - push @{$doc}, $tree->{$var}{_doc} if $tree->{$var}{_doc} ; - my $inherited = $tree->{_inherited} and - grep {$_ eq $var} @{$tree->{_inherited}}; - push @{$doc}, "This variable I<inherits> its value from the parent section if nothing is specified here." - if $inherited; - push @{$doc}, "This variable I<dynamically> modifies the grammar based on its value." - if $tree->{$var}{_dyn}; - push @{$doc}, "Default value: $var = $tree->{$var}{_default}" - if ($tree->{$var}{_default}); - push @{$doc}, "Example: $var = $tree->{$var}{_example}" - if ($tree->{$var}{_example}) + push @{$doc}, _describevar($tree, $var); } push @{$doc}, "=back"; } @@ -725,22 +856,60 @@ sub _genpod($$$){ push @{$doc}, ($level > 0) ? "=item B<".("+" x $level)."$section>$mandatory" : "=head2 *** $section ***$mandatory"; + if ($tree eq $tree->{$section}) { + push @{$doc}, "This subsection has the same syntax as its parent."; + next; + } push @{$doc}, ($tree->{$section}{_doc}) if $tree->{$section}{_doc}; push @{$doc}, "The grammar of this section is I<dynamically> modified based on its name." if $tree->{$section}{_dyn}; - if ($tree eq $tree->{$section} or - ($tree->{_recursive} and - grep {$_ eq $section} @{$tree->{_recursive}})) { + if ($tree->{_recursive} and + grep {$_ eq $section} @{$tree->{_recursive}}) { push @{$doc}, "This section is I<recursive>: it can contain subsection(s) with the same syntax."; - } else { - _genpod ($tree->{$section},$level+1,$doc) + } + _genpod ($tree->{$section},$level+1,$doc); + next unless $tree->{$section}{_dyn} and $tree->{$section}{_dyndoc}; + push @{$doc}, "Dynamical grammar changes for example instances of this section:"; + push @{$doc}, "=over"; + for my $name (sort keys %{$tree->{$section}{_dyndoc}}) { + my $newtree = _deepcopy($tree->{$section}); + push @{$doc}, "=item B<$name>: $tree->{$section}{_dyndoc}{$name}"; + &{$tree->{$section}{_dyn}}($section, $name, $newtree); + my @tdoc = _diffgrammars($tree->{$section}, $newtree); + if (@tdoc) { + push @{$doc}, @tdoc; + } else { + push @{$doc}, "No changes that can be automatically described."; + } + push @{$doc}, "(End of dynamical grammar changes for example instance C<$name>.)"; } - - - } + push @{$doc}, "=back"; + push @{$doc}, "(End of dynamical grammar changes for example instances of section C<$section>.)"; + } push @{$doc}, "=back" if $level > 0 } + if ($tree->{_vars}) { + for my $var (@{$tree->{_vars}}) { + next unless $tree->{$var}{_dyn} and $tree->{$var}{_dyndoc}; + push @{$doc}, "Dynamical grammar changes for example values of variable C<$var>:"; + push @{$doc}, "=over"; + for my $val (sort keys %{$tree->{$var}{_dyndoc}}) { + my $newtree = _deepcopy($tree); + push @{$doc}, "=item B<$val>: $tree->{$var}{_dyndoc}{$val}"; + &{$tree->{$var}{_dyn}}($var, $val, $newtree); + my @tdoc = _diffgrammars($tree, $newtree); + if (@tdoc) { + push @{$doc}, @tdoc; + } else { + push @{$doc}, "No changes that can be automatically described."; + } + push @{$doc}, "(End of dynamical grammar changes for variable C<$var> example value C<$val>.)"; + } + push @{$doc}, "=back"; + push @{$doc}, "(End of dynamical grammar changes for example values of variable C<$var>.)"; + } + } }; sub makepod($) { @@ -867,6 +1036,7 @@ sub parse($$) 1 __END__ + =head1 NAME ISG::ParseConfig - Simple config parser @@ -965,10 +1135,29 @@ If defined, a '_order' element will be put in every hash containing the sections with a number that determines the order in which the sections were defined. +=item _varlist + +If defined, a '_varlist' element will be put in the config hash of this +section with a list of the variables defined in the section. This can +be used to find out the order of the variable assignments. + +The '_sub' function (see below) of any variables defined in this section +will also receive a list of those variables already defined in the +same section. This can be used to enforce the order of the variables +during parsing. + =item _doc Describes what this section is about +=item _sub + +A function pointer. It is called for every instance of this section, +with the real name of the section passed as its first argument. This is +probably only useful for the regexp sections. If the function returns +a defined value it is assumed that the test was not successful and an +error is generated with the returned string as content. + =item _dyn A subroutine reference (function pointer) that will be called when @@ -978,6 +1167,18 @@ actual name encountered (this will be the same as the first argument for non-regexp sections) and a reference to the grammar tree of the section. This subroutine can then modify the grammar tree dynamically. +=item _dyndoc + +A hash reference that lists interesting names for the section that +should be documented. The keys of the hash are the names and the +values in the hash are strings that can contain an explanation +for the name. The _dyn() subroutine is then called for each of +these names and the differences of the resulting grammar and +the original one are documented. This module can currently document +differences in the _vars list, listing new variables and removed +ones, and differences in the _sections list, listing the +new and removed sections. + =back =head3 Special Variable Keys @@ -1000,13 +1201,18 @@ first argument. If the function returns a defined value it is assumed that the test was not successful and an error is generated with the returned string as content. +If the '_varlist' key (see above) is defined in this section, the '_sub' +function will also receive an array reference as the second argument. The +array contains a list of those variables already defined in the same +section. This can be used to enforce the order of the variables. + =item _default A default value that will be assigned to the variable if none is specified or inherited. =item _doc -Describtion of the variable. +Description of the variable. =item _example @@ -1023,6 +1229,18 @@ then modify the grammar tree dynamically. Note that no _dyn() call is made for default and inherited values of the variable. +=item _dyndoc + +A hash reference that lists interesting values for the variable that +should be documented. The keys of the hash are the values and the +values in the hash are strings that can contain an explanation +for the value. The _dyn() subroutine is then called for each of +these values and the differences of the resulting grammar and +the original one are documented. This module can currently document +differences in the _vars list, listing new variables and removed +ones, and differences in the _sections list, listing the +new and removed sections. + =back =head3 Special Table Keys |