From e8783b5de226f8c5e338e04c38aa4b692c986fd8 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Wed, 26 Sep 2007 09:07:57 +0000 Subject: integrated real config grammar 1.10 --- lib/Config/Grammar.pm | 236 +++++--------------------------------------------- 1 file changed, 24 insertions(+), 212 deletions(-) (limited to 'lib/Config/Grammar.pm') diff --git a/lib/Config/Grammar.pm b/lib/Config/Grammar.pm index 3291042..0b53c7c 100644 --- a/lib/Config/Grammar.pm +++ b/lib/Config/Grammar.pm @@ -1,8 +1,4 @@ package Config::Grammar; - -# TODO: -# - _order for sections - use strict; $Config::Grammar::VERSION = '1.10'; @@ -75,9 +71,6 @@ sub _check_mandatory($$$$) for (@{$g->{_mandatory}}) { if (not defined $g->{$_}) { $g->{$_} = {}; - -#$self->{'err'} = "Config::Grammar internal error: mandatory name $_ not found in grammar"; - #return 0; } if (not defined $c->{$_}) { if (defined $section) { @@ -184,7 +177,7 @@ sub _next_level($$$) my $s = $self->_search_section($name); return 0 unless defined $s; if (not defined $self->{grammar}{$s}) { - $self->_make_error("ParseConfig internal error (no grammar for $s)"); + $self->_make_error("Config::Grammar internal error (no grammar for $s)"); return 0; } push @{$self->{grammar_stack}}, $self->{grammar}; @@ -479,12 +472,6 @@ sub _check_text($$) $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; } - # TODO: not good for META. Use _mandatory ? - #defined $self->{cfg}{_text} or do { - # $self->_make_error("value of '$name' not defined"); - # return 0; - #}; - if (defined $g->{_re}) { $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { if (defined $g->{_re_error}) { @@ -631,210 +618,31 @@ sub _parse_file($$) return 1; } -# 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 its value from the parent section if nothing is specified here." - if $inherited; - 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, $level, $doc) = @_; - if ($tree->{_vars}){ - push @{$doc}, "The following variables can be set in this section:"; - push @{$doc}, "=over"; - foreach my $var (@{$tree->{_vars}}){ - push @{$doc}, _describevar($tree, $var); - } - push @{$doc}, "=back"; - } - - if ($tree->{_text}){ - push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content"); - if ($tree->{_text}{_example}){ - my $ex = $tree->{_text}{_example}; - chomp $ex; - $ex = map {" $_"} split /\n/, $ex; - push @{$doc}, "Example:\n\n$ex\n"; - } - } - - if ($tree->{_table}){ - push @{$doc}, ($tree->{_table}{_doc} or - "This section can contain a table ". - "with the following structure:" ); - push @{$doc}, "=over"; - for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ - push @{$doc}, "=item column $i"; - push @{$doc}, ($tree->{_table}{$i}{_doc} or - "Unspecific Content"); - push @{$doc}, "Example: $tree->{_table}{$i}{_example}" - if ($tree->{_table}{$i}{_example}) - } - push @{$doc}, "=back"; - } - if ($tree->{_sections}){ - if ($level > 0) { - push @{$doc}, "The following sections are valid on level $level:"; - push @{$doc}, "=over"; - } - foreach my $section (@{$tree->{_sections}}){ - my $mandatory = ( $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}} ) ? - " I<(mandatory section)>" : ""; - 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}; - _genpod($tree->{$section},$level+1,$doc); - } - push @{$doc}, "=back" if $level > 0 - } -}; - sub makepod($) { - my $self = shift; - my $tree = $self->{grammar}; - my @doc; - _genpod($tree,0,\@doc); - return join("\n\n", @doc)."\n"; + my $pod = eval { + require Config::Grammar::Document; + return Config::Grammar::Document::makepod(@_); + }; + defined $pod or die "ERROR: install Config::Grammar::Document in order to use makepod(): $@\n"; + return $pod; } -sub _gentmpl($$$@); -sub _gentmpl($$$@){ - my $tree = shift; - my $complete = shift; - my $level = shift; - my $doc = shift; - my @start = @_; - if (scalar @start ) { - my $section = shift @start; - my $secex =''; - my $prefix = ''; - $prefix = "# " unless $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}}; - if ($tree->{$section}{_example}) { - $secex = " # ( ex. $tree->{$section}{_example} )"; - } - - if($complete) { - push @{$doc}, $prefix. - (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").$secex; - } else { - my $minsection=$section =~ m|^/| ? "" : $section; - push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***"); - } - - my $match; - foreach my $s (@{$tree->{_sections}}){ - if ($s =~ m|^/.+/$| and $section =~ /$s/ or $s eq $section) { - _gentmpl ($tree->{$s},$complete,$level+1,$doc,@start) - unless $tree eq $tree->{$s}; - $match = 1; - } - } - push @{$doc}, "# Section $section is not a valid choice" - unless $match; - } else { - if ($tree->{_vars}){ - foreach my $var (@{$tree->{_vars}}){ - my $mandatory= ($tree->{_mandatory} and - grep {$_ eq $var} @{$tree->{_mandatory}}); - if($complete) { - push @{$doc}, "# $var = ". - ($tree->{$var}{_example} || ' * no example *'); - push @{$doc}, "$var=" if $mandatory; - } else { - push @{$doc}, ($mandatory?"":"# ")."$var="; - next unless $tree->{_mandatory} and - grep {$_ eq $var} @{$tree->{_mandatory}}; - } - } - } - - if ($tree->{_text} and $complete){ - if ($tree->{_text}{_example}){ - my $ex = $tree->{_text}{_example}; - chomp $ex; - $ex = map {"# $_"} split /\n/, $ex; - push @{$doc}, "$ex\n"; - } - } - if ($tree->{_table} and $complete){ - my $table = "# table\n#"; - for (my $i=0;$i < $tree->{_table}{_columns}; $i++){ - $table .= ' "'.($tree->{_table}{$i}{_example} || "C$i").'"'; - } - push @{$doc}, $table; - } - if ($tree->{_sections}){ - foreach my $section (@{$tree->{_sections}}){ - my $opt = ""; - unless( $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}} ) { - $opt="\n# optional section\n" if $complete; - } - my $prefix = ''; - $prefix = "# " unless $tree->{_mandatory} and - grep {$_ eq $section} @{$tree->{_mandatory}}; - my $secex =""; - if ($section =~ m|^/.+/$| && $tree->{$section}{_example}) { - $secex = " # ( ex. $tree->{$section}{_example} )" - if $complete; - } - if($complete) { - push @{$doc}, $prefix. - (($level > 0) ? ("+" x $level)."$section" : "*** $section ***"). - $secex; - } else { - my $minsection=$section =~ m|^/| ? "" : $section; - push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***"); - } - _gentmpl ($tree->{$section},$complete,$level+1,$doc,@start) - unless $tree eq $tree->{$section}; - } - } - } -}; - sub maketmpl ($@) { - my $self = shift; - my @start = @_; - my $tree = $self->{grammar}; - my @tmpl; - _gentmpl $tree,1,0,\@tmpl,@start; - return join("\n", @tmpl)."\n"; + my $pod = eval { + require Config::Grammar::Document; + return Config::Grammar::Document::maketmpl(@_); + }; + defined $pod or die "ERROR: install Config::Grammar::Document in order to use maketmpl()\n"; + return $pod; } sub makemintmpl ($@) { - my $self = shift; - my @start = @_; - my $tree = $self->{grammar}; - my @tmpl; - _gentmpl $tree,0,0,\@tmpl,@start; - return join("\n", @tmpl)."\n"; + my $pod = eval { + require Config::Grammar::Document; + return Config::Grammar::Document::makemintmpl(@_); + }; + defined $pod or die "ERROR: install Config::Grammar::Document in order to use makemintmpl()\n"; + return $pod; } sub parse($$) @@ -863,7 +671,7 @@ sub parse($$) } -1 +1; __END__ @@ -1247,6 +1055,10 @@ The data is interpreted as one or more columns separated by spaces. } }; +=head1 SEE ALSO + +L + =head1 COPYRIGHT Copyright (c) 2000-2005 by ETH Zurich. All rights reserved. -- cgit v1.2.3-24-g4f1b