File Coverage

lib/Config/Grammar/Document.pm
Criterion Covered Total %
statement 106 162 65.4
branch 48 92 52.1
condition 20 50 40.0
subroutine 5 6 83.3
pod 0 3 0.0
total 179 313 57.1


line stmt bran cond sub pod time code
1             package Config::Grammar::Document;
2              
3             # This is a helper class for Config::Grammar implementing the logic
4             # of its documentation-generating methods.
5             #
6             # This code is placed here instead of Config::Grammar in order to make
7             # the main module leaner. These methods are only used in special cases.
8             # Note that the installation of this module is optional: if you don't install
9             # it, the make...() methods just won't work.
10              
11             sub _describevar {
12 4     4   3 my $tree = shift;
13 4         4 my $var = shift;
14             my $mandatory = ( $tree->{_mandatory} and
15 4 50 33     8 grep {$_ eq $var} @{$tree->{_mandatory}} ) ?
16             " I<(mandatory setting)>" : "";
17 4         4 my @doc;
18 4         7 push @doc, "=item B<$var>".$mandatory;
19 4 50       9 push @doc, $tree->{$var}{_doc} if $tree->{$var}{_doc} ;
20             my $inherited = ( $tree->{_inherited} and
21 4   33     8 grep {$_ eq $var} @{$tree->{_inherited}});
22 4 50       5 push @doc, "This variable I its value from the parent section if nothing is specified here."
23             if $inherited;
24             push @doc, "Default value: $var = $tree->{$var}{_default}"
25 4 50       4 if ($tree->{$var}{_default});
26             push @doc, "Example: $var = $tree->{$var}{_example}"
27 4 50       12 if ($tree->{$var}{_example});
28 4         12 return @doc;
29             }
30              
31             sub _genpod($$$);
32             sub _genpod($$$)
33             {
34 5     5   4 my ($tree, $level, $doc) = @_;
35 5 100       12 if ($tree->{_vars}){
36 2         3 push @{$doc}, "The following variables can be set in this section:";
  2         2  
37 2         3 push @{$doc}, "=over";
  2         2  
38 2         1 foreach my $var (@{$tree->{_vars}}){
  2         4  
39 4         2 push @{$doc}, _describevar($tree, $var);
  4         5  
40             }
41 2         2 push @{$doc}, "=back";
  2         2  
42             }
43              
44 5 100       9 if ($tree->{_text}){
45 1   50     1 push @{$doc}, ($tree->{_text}{_doc} or "Unspecified Text content");
  1         4  
46 1 50       2 if ($tree->{_text}{_example}){
47 0         0 my $ex = $tree->{_text}{_example};
48 0         0 chomp $ex;
49 0         0 $ex = map {" $_"} split /\n/, $ex;
  0         0  
50 0         0 push @{$doc}, "Example:\n\n$ex\n";
  0         0  
51             }
52             }
53              
54 5 100       8 if ($tree->{_table}){
55 1         4 push @{$doc}, ($tree->{_table}{_doc} or
56 1   50     1 "This section can contain a table ".
57             "with the following structure:" );
58 1         1 push @{$doc}, "=over";
  1         2  
59 1         3 for (my $i=0;$i < $tree->{_table}{_columns}; $i++){
60 3         3 push @{$doc}, "=item column $i";
  3         4  
61 3         9 push @{$doc}, ($tree->{_table}{$i}{_doc} or
62 3   100     2 "Unspecific Content");
63 2         6 push @{$doc}, "Example: $tree->{_table}{$i}{_example}"
64             if ($tree->{_table}{$i}{_example})
65 3 100       6 }
66 1         1 push @{$doc}, "=back";
  1         2  
67             }
68 5 100       11 if ($tree->{_sections}){
69 2 100       3 if ($level > 0) {
70 1         1 push @{$doc}, "The following sections are valid on level $level:";
  1         3  
71 1         0 push @{$doc}, "=over";
  1         2  
72             }
73 2         2 foreach my $section (@{$tree->{_sections}}){
  2         3  
74             my $mandatory = ( $tree->{_mandatory} and
75 4 50 33     10 grep {$_ eq $section} @{$tree->{_mandatory}} ) ?
76             " I<(mandatory section)>" : "";
77 4 100       2 push @{$doc}, ($level > 0) ?
  4         11  
78             "=item B<".("+" x $level)."$section>$mandatory" :
79             "=head2 *** $section ***$mandatory";
80 4 50       9 if ($tree eq $tree->{$section}) {
81 0         0 push @{$doc}, "This subsection has the same syntax as its parent.";
  0         0  
82 0         0 next;
83             }
84 2         3 push @{$doc}, ($tree->{$section}{_doc})
85 4 100       8 if $tree->{$section}{_doc};
86 4         15 _genpod($tree->{$section},$level+1,$doc);
87             }
88 2 100       12 push @{$doc}, "=back" if $level > 0
  1         3  
89             }
90             };
91              
92             sub makepod($) {
93 1     1 0 1 my $self = shift;
94 1         2 my $tree = $self->{grammar};
95 1         1 my @doc;
96 1         3 _genpod($tree,0,\@doc);
97 1         9 return join("\n\n", @doc)."\n";
98             }
99              
100             sub _gentmpl($$$@);
101             sub _gentmpl($$$@){
102 11     11   9 my $tree = shift;
103 11         8 my $complete = shift;
104 11         5 my $level = shift;
105 11         10 my $doc = shift;
106 11         11 my @start = @_;
107 11 50       15 if (scalar @start ) {
108 0         0 my $section = shift @start;
109 0         0 my $secex ='';
110 0         0 my $prefix = '';
111             $prefix = "# " unless $tree->{_mandatory} and
112 0 0 0     0 grep {$_ eq $section} @{$tree->{_mandatory}};
  0         0  
  0         0  
113 0 0       0 if ($tree->{$section}{_example}) {
114 0         0 $secex = " # ( ex. $tree->{$section}{_example} )";
115             }
116              
117 0 0       0 if($complete) {
118 0 0       0 push @{$doc}, $prefix.
  0         0  
119             (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").$secex;
120             } else {
121 0 0       0 my $minsection=$section =~ m|^/| ? "" : $section;
122 0 0       0 push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***");
  0         0  
123             }
124            
125 0         0 my $match;
126 0         0 foreach my $s (@{$tree->{_sections}}){
  0         0  
127 0 0 0     0 if ($s =~ m|^/.+/$| and $section =~ /$s/ or $s eq $section) {
      0        
128             _gentmpl ($tree->{$s},$complete,$level+1,$doc,@start)
129 0 0       0 unless $tree eq $tree->{$s};
130 0         0 $match = 1;
131             }
132             }
133 0 0       0 push @{$doc}, "# Section $section is not a valid choice"
  0         0  
134             unless $match;
135             } else {
136 11 100       18 if ($tree->{_vars}){
137 7         7 foreach my $var (@{$tree->{_vars}}){
  7         10  
138             my $mandatory= ($tree->{_mandatory} and
139 20   33     26 grep {$_ eq $var} @{$tree->{_mandatory}});
140 20 50       25 if($complete) {
141 20         68 push @{$doc}, "# $var = ".
142 20   100     12 ($tree->{$var}{_example} || ' * no example *');
143 20 50       32 push @{$doc}, "$var=" if $mandatory;
  0         0  
144             } else {
145 0 0       0 push @{$doc}, ($mandatory?"":"# ")."$var=";
  0         0  
146             next unless $tree->{_mandatory} and
147 0 0 0     0 grep {$_ eq $var} @{$tree->{_mandatory}};
  0         0  
  0         0  
148             }
149             }
150             }
151              
152 11 100 66     21 if ($tree->{_text} and $complete){
153 1 50       2 if ($tree->{_text}{_example}){
154 0         0 my $ex = $tree->{_text}{_example};
155 0         0 chomp $ex;
156 0         0 $ex = map {"# $_"} split /\n/, $ex;
  0         0  
157 0         0 push @{$doc}, "$ex\n";
  0         0  
158             }
159             }
160 11 100 66     22 if ($tree->{_table} and $complete){
161 1         1 my $table = "# table\n#";
162 1         6 for (my $i=0;$i < $tree->{_table}{_columns}; $i++){
163 3   66     11 $table .= ' "'.($tree->{_table}{$i}{_example} || "C$i").'"';
164             }
165 1         1 push @{$doc}, $table;
  1         2  
166             }
167 11 100       23 if ($tree->{_sections}){
168 7         6 foreach my $section (@{$tree->{_sections}}){
  7         12  
169 8         21 my $opt = "";
170 8 50 33     16 unless( $tree->{_mandatory} and
171 0         0 grep {$_ eq $section} @{$tree->{_mandatory}} ) {
  0         0  
172 8 50       13 $opt="\n# optional section\n" if $complete;
173             }
174 8         8 my $prefix = '';
175             $prefix = "# " unless $tree->{_mandatory} and
176 8 50 33     17 grep {$_ eq $section} @{$tree->{_mandatory}};
  0         0  
  0         0  
177 8         7 my $secex ="";
178 8 100 66     25 if ($section =~ m|^/.+/$| && $tree->{$section}{_example}) {
179 1 50       3 $secex = " # ( ex. $tree->{$section}{_example} )"
180             if $complete;
181             }
182 8 50       12 if($complete) {
183 8 100       7 push @{$doc}, $prefix.
  8         24  
184             (($level > 0) ? ("+" x $level)."$section" : "*** $section ***").
185             $secex;
186             } else {
187 0 0       0 my $minsection=$section =~ m|^/| ? "" : $section;
188 0 0       0 push @{$doc},(($level > 0) ? ("+" x $level)."$minsection" : "*** $minsection ***");
  0         0  
189             }
190             _gentmpl ($tree->{$section},$complete,$level+1,$doc,@start)
191 8 50       70 unless $tree eq $tree->{$section};
192             }
193             }
194             }
195             };
196              
197             sub maketmpl ($@) {
198 3     3 0 4 my $self = shift;
199 3         4 my @start = @_;
200 3         5 my $tree = $self->{grammar};
201 3         3 my @tmpl;
202 3         5 _gentmpl $tree,1,0,\@tmpl,@start;
203 3         19 return join("\n", @tmpl)."\n";
204             }
205              
206             sub makemintmpl ($@) {
207 0     0 0   my $self = shift;
208 0           my @start = @_;
209 0           my $tree = $self->{grammar};
210 0           my @tmpl;
211 0           _gentmpl $tree,0,0,\@tmpl,@start;
212 0           return join("\n", @tmpl)."\n";
213             }
214              
215             1;