integrated real config grammar 1.10

3 files changed, 240 insertions, 213 deletions

diff --git a/CHANGES b/CHANGES
index 416cdaa..7b01c00 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,4 @@
-* switched to config grammar 1.10 (pre release) -- tobi
+* switched to config grammar 1.10  -- tobi
 
 * make sure reload_config reloads in any case even when the config has not changed ... 
   with this we solve the problem that maybe some @include configs have changed
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<inherits> 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<Config::Grammar::Dynamic>
+
 =head1 COPYRIGHT
 
 Copyright (c) 2000-2005 by ETH Zurich. All rights reserved.
diff --git a/lib/Config/Grammar/Document.pm b/lib/Config/Grammar/Document.pm
new file mode 100644
index 0000000..5e9a87c
--- /dev/null
+++ b/lib/Config/Grammar/Document.pm
@@ -0,0 +1,215 @@
+package Config::Grammar::Document;
+
+# This is a helper class for Config::Grammar implementing the logic
+# of its documentation-generating methods.
+# 
+# This code is placed here instead of Config::Grammar in order to make
+# the main module leaner. These methods are only used in special cases.
+# Note that the installation of this module is optional: if you don't install
+# it, the make...() methods just won't work.
+
+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, "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";
+}
+
+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";
+}
+
+sub makemintmpl ($@) {
+    my $self = shift;
+    my @start = @_;
+    my $tree = $self->{grammar};
+    my @tmpl;
+    _gentmpl $tree,0,0,\@tmpl,@start;
+    return join("\n", @tmpl)."\n";
+}
+
+1;