integrated real config grammar 1.10

1 files changed, 24 insertions, 212 deletions

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.