X-Git-Url: https://git.camperquake.de/gitweb.cgi?p=quotesite.git;a=blobdiff_plain;f=quotesite%2FBase.pm;h=08897c9a86cdd006eb651483d0560890c21d8065;hp=d8a4e988b50ec500f23719752ea38ab7af063f84;hb=20af9b1c4f051c0830ba35b8d3d15439c499e119;hpb=7a2a97ead43f07fbeb25bca43f40c7f994cc77ab diff --git a/quotesite/Base.pm b/quotesite/Base.pm index d8a4e98..08897c9 100644 --- a/quotesite/Base.pm +++ b/quotesite/Base.pm @@ -8,7 +8,7 @@ use Data::Dumper; sub new { my $class = shift; - my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}}; + my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}, '_OUTSTACK' => []}; bless($self, $class); @@ -91,6 +91,23 @@ sub setio { $self->{'_OUT'} = $io; } +sub pushio { + my $self = shift; + my $io = shift; + + push(@{$self->{'_OUTSTACK'}}, $self->{'_OUT'}); + $self->setio($io); +} + +sub popio { + my $self = shift; + my $io = pop(@{$self->{'_OUTSTACK'}}); + + if (defined($io)) { + $self->setio($io); + } +} + sub getconfstr { my $self = shift; my $s = 'Options for ' . $self->{'NAME'} . ":\n"; @@ -111,6 +128,30 @@ sub getconfstr { return $s; } +# Return a list of the parameters supported by the module +# Does not return the 'enabled' parameter +sub getparamlist { + my $self = shift; + my $word = shift; + + return grep {$_ ne 'enabled' && /^$word/} keys %{$self->{'_PARAMS'}}; +} + +# Return a list of valid parameter values, if the parameter has +# such a list. +sub getparamvalues { + my $self = shift; + my $param = shift; + my $word = shift; + + unless(exists($self->{'_PARAMS'}->{$param}->[2])) { + return (); + } else { + return grep {/^$word/} keys %{$self->{'_PARAMS'}->{$param}->[2]}; + } +} + + sub gethelpstr { my $self = shift; my $s = 'Help for ' . $self->{'NAME'} . ":\n"; @@ -125,7 +166,16 @@ sub gethelpstr { foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) { $p = $self->{'_PARAMS'}->{$k}->[0]; $p =~ s/%/%%/g; - $s .= sprintf(" %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p); + if (exists($self->{'_PARAMS'}->{$k}->[2])) { + # The parameter has a list of allowed values. Add the keys and their help + $s .= sprintf(" %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p); + foreach (sort keys(%{$self->{'_PARAMS'}->{$k}->[2]})) { + $s .= sprintf(" %s: %s\n", $_, $self->{'_PARAMS'}->{$k}->[2]->{$_}); + } + } else { + # The parameter just has a default value and a help text + $s .= sprintf(" %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p); + } } return $s;