quotesite/Base.pm

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