X-Git-Url: https://git.camperquake.de/gitweb.cgi?a=blobdiff_plain;f=videosite%2FBase.pm;h=67ca218e3d33080405f44f81c33468d81c6f2ff3;hb=3ed1591b5189c9fd6474880b50ff9af831df6e16;hp=cad437428f4eb4509aab67701f72a50a573a37ba;hpb=844f3a7ee84b480f3a23b328259bd2fc69981066;p=videosite.git diff --git a/videosite/Base.pm b/videosite/Base.pm index cad4374..67ca218 100644 --- a/videosite/Base.pm +++ b/videosite/Base.pm @@ -1,15 +1,17 @@ # (c) 2007 by Ralf Ertzinger # licensed under GNU GPL v2 -package Base; +package videosite::Base; use strict; +use LWP::UserAgent; +use HTTP::Cookies; use Data::Dumper; sub new { my $class = shift; - my $self = {'_DEBUG' => 0, '_OUT' => sub {}}; - + my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}}; + bless($self, $class); $self->_prepare_parameters(); @@ -19,11 +21,11 @@ sub new { sub error { my $self = shift; - my $t; + my @data = @_; + + $data[0] = "(" . ref($self) . ") " . $data[0]; - $t = sprintf(shift(@_), @_); - $t =~ s/%/%%/g; - $self->{'_OUT'}($t); + $self->{'_OUT'}(@data); } sub debug { @@ -111,6 +113,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 +151,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; @@ -137,4 +172,10 @@ sub setdebug { $self->{'_DEBUG'} = shift; } +sub ua { + my $self = shift; + + return LWP::UserAgent->new('agent' => 'Mozilla/5.0', 'cookie_jar' => HTTP::Cookies->new); +} + 1;