videosite/Base.pm

   1 # (c) 2007 by Ralf Ertzinger <ralf@camperquake.de>
   2 # licensed under GNU GPL v2
   3
   4 package videosite::Base;
   5
   6 use strict;
   7 use LWP::UserAgent;
   8 use HTTP::Cookies;
   9 use Data::Dumper;
  10
  11 sub new {
  12     my $class = shift;
  13     my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}};
  14
  15     $self->{_ua} = LWP::UserAgent->new('agent' => 'Mozilla/5.0', 'cookie_jar' => HTTP::Cookies->new);
  16
  17     bless($self, $class);
  18
  19     $self->_prepare_parameters();
  20
  21     return $self;
  22 }
  23
  24 sub error {
  25     my $self = shift;
  26     my @data = @_;
  27
  28     $data[0] = "(" . ref($self) . ") " . $data[0];
  29
  30     $self->{'_OUT'}(@data);
  31 }
  32
  33 sub debug {
  34     my $self = shift;
  35     my @data = @_;
  36
  37     $data[0] = "DEBUG: " . $data[0];
  38     if ($self->{'_DEBUG'} != 0) {$self->error(@data)};
  39 }
  40
  41 sub mergeconfig {
  42     my $self = shift;
  43     my $c = shift;
  44     my $o;
  45
  46     return $self->{'_CONFIG'} unless defined($c);
  47
  48     foreach $o (keys(%{$c->{'option'}})) {
  49         if (exists($self->{'_CONFIG'}->{'option'}->{$o})) {
  50             $self->{'_CONFIG'}->{'option'}->{$o}->{'content'} = $c->{'option'}->{$o}->{'content'};
  51         }
  52     }
  53
  54     return $self->{'_CONFIG'};
  55 }
  56
  57 sub _prepare_parameters {
  58     my $self = shift;
  59     my $p;
  60
  61     $self->{'_CONFIG'} = {'option' => {'enabled' => {'content' => '1'}}};
  62
  63     foreach $p (keys(%{$self->{'_PARAMS'}})) {
  64         $self->{'_CONFIG'}->{'option'}->{$p}->{'content'} = $self->{'_PARAMS'}->{$p}->[0];
  65     }
  66 }
  67
  68 sub _getval {
  69     my $self = shift;
  70     my $key = shift;
  71     my $val;
  72
  73     $val = $self->{'_CONFIG'}->{'option'}->{$key}->{'content'};
  74     $self->debug('Returning %s=%s', $key, $val);
  75
  76     return $val;
  77 }
  78
  79 sub setval {
  80     my $self = shift;
  81     my $key = shift;
  82     my $val = shift;
  83
  84     if (exists($self->{'_CONFIG'}->{'option'}->{$key})) {
  85         $self->{'_CONFIG'}->{'option'}->{$key}->{'content'} = $val;
  86     } else {
  87         $self->error('Module %s does not have a parameter named %s', $self->{'NAME'}, $key);
  88     }
  89 }
  90
  91 sub setio {
  92     my $self = shift;
  93     my $io = shift;
  94
  95     $self->{'_OUT'} = $io;
  96 }
  97
  98 sub getconfstr {
  99     my $self = shift;
 100     my $s = 'Options for ' . $self->{'NAME'} . ":\n";
 101     my $k;
 102     my $p;
 103
 104     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
 105         $p = $self->{'_CONFIG'}->{'option'}->{$k}->{'content'};
 106         $p =~ s/%/%%/g;
 107         $s .= sprintf("  %s: %s", $k, $p);
 108         if ($self->{'_CONFIG'}->{'option'}->{$k}->{'content'} eq $self->{'_PARAMS'}->{$k}->[0]) {
 109             $s .= " (default)\n";
 110         } else {
 111             $s .= "\n";
 112         }
 113     }
 114
 115     return $s;
 116 }
 117
 118 # Return a list of the parameters supported by the module
 119 # Does not return the 'enabled' parameter
 120 sub getparamlist {
 121     my $self = shift;
 122     my $word = shift;
 123
 124     return grep {$_ ne 'enabled' && /^$word/} keys %{$self->{'_PARAMS'}};
 125 }
 126
 127 # Return a list of valid parameter values, if the parameter has
 128 # such a list.
 129 sub getparamvalues {
 130     my $self = shift;
 131     my $param = shift;
 132     my $word = shift;
 133
 134     unless(exists($self->{'_PARAMS'}->{$param}->[2])) {
 135         return ();
 136     } else {
 137         return grep {/^$word/} keys %{$self->{'_PARAMS'}->{$param}->[2]};
 138     }
 139 }
 140
 141
 142 sub gethelpstr {
 143     my $self = shift;
 144     my $s = 'Help for ' . $self->{'NAME'} . ":\n";
 145     my $k;
 146     my $p;
 147
 148     if (exists($self->{'DESC'})) {
 149         $s .= "Description:\n " . $self->{'DESC'};
 150     }
 151
 152     $s .= " Options:\n";
 153     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
 154         $p = $self->{'_PARAMS'}->{$k}->[0];
 155         $p =~ s/%/%%/g;
 156         if (exists($self->{'_PARAMS'}->{$k}->[2])) {
 157             # The parameter has a list of allowed values. Add the keys and their help
 158             $s .= sprintf("  %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
 159             foreach (sort keys(%{$self->{'_PARAMS'}->{$k}->[2]})) {
 160                 $s .= sprintf("     %s: %s\n", $_, $self->{'_PARAMS'}->{$k}->[2]->{$_});
 161             }
 162         } else {
 163             # The parameter just has a default value and a help text
 164             $s .= sprintf("  %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
 165         }
 166     }
 167
 168     return $s;
 169 }
 170
 171 sub setdebug {
 172     my $self = shift;
 173
 174     $self->{'_DEBUG'} = shift;
 175 }
 176
 177 1;