[Lxr-commits] CVS: lxr showconfig,1.2,1.3
Brought to you by:
ajlittoz
From: Andre-Littoz <ajl...@us...> - 2013-09-24 08:39:11
|
Update of /cvsroot/lxr/lxr In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv6187 Modified Files: showconfig Log Message: showconfig: new features Edit arrays in hash Correct "Force all" display (tree-specific and global values no longer mixed up) New _confall=2 for developers (really complete dump) Variants in tree designation taken into account Better comments Various Perl syntax optimisations Index: showconfig =================================================================== RCS file: /cvsroot/lxr/lxr/showconfig,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- showconfig 21 Sep 2012 08:18:02 -0000 1.2 +++ showconfig 24 Sep 2013 08:39:05 -0000 1.3 @@ -1,6 +1,7 @@ #!/usr/bin/perl -T +###################################################################### # $Id$ - +# # showconfig -- Present LXR configuration as html # # Andre J Littoz <ajl...@us...> @@ -19,13 +20,13 @@ # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - +# ###################################################################### =head1 script showconfig This script shows how LXR understood the configuration parameters -from lxr.conf file. They are displayed in tabular form: +from F<lxr.conf> file. They are displayed in tabular form: First column: parameter name @@ -35,7 +36,7 @@ Fourth column: value from global parameter group -With such a layout, it is easy to see if a global value is overriden +With such a layout, it is easy to see if a global value is overridden by a specific one. =cut @@ -43,7 +44,7 @@ $CVSID = '$Id$ '; use strict; -use lib do { $0 =~ m{(.*)/} ? "$1/lib" : "lib" }; # if LXR modules are in ./lib +use lib do { $0 =~ m{(.*)/} ? "$1/lib" : 'lib' }; # if LXR modules are in ./lib use LXR::Common; use LXR::Template; @@ -55,9 +56,8 @@ as a ready-to-print string. The value of a key may be a simple I<string> (displayed surrounded -with quotes), an I<array> (simply indicated with an ellipsis to limit -recursion) or a I<hash> (recursively dumped surrounded wit curly -braces). +with quotes), an I<array> (dumped "as is" without checking for further +references) or a I<hash> (recursively dumped surrounded with curly braces). =over @@ -81,13 +81,20 @@ foreach my $k (sort keys %$h) { $d .= "'$k' => "; # Compute left spaces in case we need to recurse + $d =~ m/([^\n]*)$/s; + my $indent = length($1); my $v = %$h->{$k}; if (ref($v) eq 'ARRAY') { - $d .= '[ ... ]'; + $d .= '[ ' . join("\n".' 'x$indent.', ', @$v); + if (1 < scalar(@$v)) { + $d .= "\n".' 'x$indent; + } else { + $d .= ' '; + } + $d .= ']'; } elsif (ref($v) eq 'HASH') { - $d =~ m/([^\n]*)$/s; $d .= "\n"; - $d .= dumphash ($v, length($1)); + $d .= dumphash ($v, $indent); } else { $d .= "'$v'"; } @@ -114,7 +121,7 @@ =item 1 C<$parm> -a parameter name as a I<hash> +a parameter name as a I<string> =item 1 C<$pg> @@ -127,16 +134,17 @@ sub parmvalue { my $parm = shift; my $pg = shift; + my $fallback = shift; - return '' if !exists($pg->{$parm}); - my $val = $pg->{$parm}; + return '' if !exists($pg->{$parm}) && !defined($fallback); + my $val = $pg->{$parm} // $fallback->{$parm}; if (ref($val) eq 'HASH') { - return "<pre>" . dumphash($val, 0) . "</pre>"; + return '<pre>' . dumphash($val, 0) . '</pre>'; } elsif (ref($val) eq 'ARRAY') { - return "<pre>" . join('<br>', @$val) . "</pre>"; + return '<pre>' . join('<br>', @$val) . '</pre>'; } else { if ('dbpass' eq $parm) { - return "<h4>Hey, that's supposed to be a secret!</h4>"; + return '<h4>Hey, that\'s supposed to be a secret!</h4>'; } else { return "<pre>$val</pre>"; } @@ -147,7 +155,7 @@ =head2 C<parmexpand ($templ, $who, $pgs, $pgnr)> -Function C<parmgrouplink> is a "$function" substitution function. +Function C<parmexpand> is a "$function" substitution function. It returns its block (contained in C<$tmpl>) expanded for each accessible configuration parameter. @@ -195,7 +203,7 @@ my @keylist = (); my $parmgroup = @$pgs[$pgnr]; my $globgroup = @$pgs[0]; - my $full = $HTTP->{'param'}{'_confall'} || 0; + my $full = $HTTP->{'param'}{'_confall'} // 0; if ($full != 0) { my %seen; @@ -204,8 +212,12 @@ $seen{$key}++; } } + if (1 < $full) { + for (keys %$config) { + $seen{$_}++ + } + } @keylist = keys(%seen); - $full = 1; } else { @keylist = keys %{{%$parmgroup, %$globgroup}}; } @@ -221,13 +233,20 @@ , ( 'force' => sub{ $extra ? 'conf_force' : '' } , 'parm' => sub{ $parm } , 'type' => sub{ - my $t = ref($config->{$parm}); - if ('HASH' eq $t || 'ARRAY' eq $t) { - return lc($t); - } else { + my $t = ref($config->{$parm}); + if ('' ne $t) { + return lc($t); + } return 'string'; - } } - , 'val' => sub{ parmvalue($parm, $parmgroup) } + } + , 'val' => sub{ parmvalue ( $parm + , $parmgroup + , ( 1 < $full + ? $config + : undef + ) + ) + } , 'global'=> sub{ parmvalue($parm, $globgroup) } @@ -238,10 +257,10 @@ } -=head2 C<parmgrouplink ($gnr, $pgs)> +=head2 C<parmgrouplink ($pgnr, $pgs)> Function C<parmgrouplink> is a "$variable" substitution function. -It returns an C<< E<lt>aE<gt> >> element invoking the +It returns an C<E<lt>AE<gt>> element invoking the I<showconfig> script to dump the designated parameter group. =over @@ -269,9 +288,18 @@ } else { return "#$pgnr <a href='" . $config->treeurl($$pgs[$pgnr], $$pgs[0]) - . "/showconfig?_parmgroup=$pgnr'>" - . $$pgs[$pgnr]->{'virtroot'} - . "</a>" ; + . 'showconfig' + . ( exists($$pgs[$pgnr]->{'treename'}) + ? '/'.$$pgs[$pgnr]->{'treename'} + : '' + ) + . "?_parmgroup=$pgnr'> " + . ($$pgs[$pgnr]->{'virtroot'} // $$pgs[0]->{'virtroot'}) + . (exists($$pgs[$pgnr]->{'treename'}) + ? '/…/' . $$pgs[$pgnr]->{'treename'} + : '' + ) + . '</a>' ; } } @@ -281,7 +309,7 @@ Output is controlled by a template Eventually, a specific parameter group may be dumped by passing -its index in argument C<_parmgroup>. +its index in URL argument C<_parmgroup>. This index may receive a default value through configuration parameter C<'parmgroupnr'>. @@ -295,7 +323,8 @@ my $who = 'showconfig'; my @pgs = $config->readconfig(); my $which = $HTTP->{'param'}{'_parmgroup'} - || $config->{'parmgroupnr'}; + // $config->{'parmgroupnr'} + // 1; makeheader($who); $templ = gettemplate ( 'htmlconfig' , $errorsig @@ -306,12 +335,18 @@ } print expandtemplate ( $templ - , ( 'conffile' => sub { "<em>" . $config->{'confpath'} . "</em>" } - , 'virtroot' => sub { $pgs[$which]->{'virtroot'} } - , 'parmgroupnr' => sub { $which } - , 'previous' => sub { parmgrouplink($which-1, \@pgs) } - , 'next' => sub { parmgrouplink($which+1, \@pgs) } - , 'conf_parm' => sub { parmexpand (@_, $who, \@pgs, $which) } + , ( 'conffile' => sub { '<em>' . $config->{'confpath'} . '</em>' } + , 'virtroot' => sub { $pgs[$which]->{'virtroot'} } + , 'parmgroupnr' => sub { $which + . (1 <$HTTP->{'param'}{'_confall'} + ? ' (apocalyptical)' + : '' + ) + } + , 'varbtnaction'=> sub { varbtnaction(@_, $who) } + , 'previous' => sub { parmgrouplink($which-1, \@pgs) } + , 'next' => sub { parmgrouplink($which+1, \@pgs) } + , 'conf_parm' => sub { parmexpand (@_, $who, \@pgs, $which) } ) ); makefooter($who); |