quotesite/Base.pm

   1 # (c) 2007 by Ralf Ertzinger <ralf@camperquake.de>
   2 # licensed under GNU GPL v2
   3
   4 package Base;
   5
   6 use strict;
   7 use Data::Dumper;
   8
   9 sub new {
  10     my $class = shift;
  11     my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}, '_OUTSTACK' => []};
  12
  13     bless($self, $class);
  14
  15     $self->_prepare_parameters();
  16
  17     return $self;
  18 }
  19
  20 sub error {
  21     my $self = shift;
  22     my $t;
  23
  24     $t = sprintf(shift(@_), @_);
  25     $t =~ s/%/%%/g;
  26     $self->{'_OUT'}($t);
  27 }
  28
  29 sub debug {
  30     my $self = shift;
  31     my @data = @_;
  32
  33     $data[0] = "DEBUG: " . $data[0];
  34     if ($self->{'_DEBUG'} != 0) {$self->error(@data)};
  35 }
  36
  37 sub mergeconfig {
  38     my $self = shift;
  39     my $c = shift;
  40     my $o;
  41
  42     return $self->{'_CONFIG'} unless defined($c);
  43
  44     foreach $o (keys(%{$c->{'option'}})) {
  45         if (exists($self->{'_CONFIG'}->{'option'}->{$o})) {
  46             $self->{'_CONFIG'}->{'option'}->{$o}->{'content'} = $c->{'option'}->{$o}->{'content'};
  47         }
  48     }
  49
  50     return $self->{'_CONFIG'};
  51 }
  52
  53 sub _prepare_parameters {
  54     my $self = shift;
  55     my $p;
  56
  57     $self->{'_CONFIG'} = {'option' => {'enabled' => {'content' => '1'}}};
  58
  59     foreach $p (keys(%{$self->{'_PARAMS'}})) {
  60         $self->{'_CONFIG'}->{'option'}->{$p}->{'content'} = $self->{'_PARAMS'}->{$p}->[0];
  61     }
  62 }
  63
  64 sub _getval {
  65     my $self = shift;
  66     my $key = shift;
  67     my $val;
  68
  69     $val = $self->{'_CONFIG'}->{'option'}->{$key}->{'content'};
  70     $self->debug('Returning %s=%s', $key, $val);
  71
  72     return $val;
  73 }
  74
  75 sub setval {
  76     my $self = shift;
  77     my $key = shift;
  78     my $val = shift;
  79
  80     if (exists($self->{'_CONFIG'}->{'option'}->{$key})) {
  81         $self->{'_CONFIG'}->{'option'}->{$key}->{'content'} = $val;
  82     } else {
  83         $self->error('Module %s does not have a parameter named %s', $self->{'NAME'}, $key);
  84     }
  85 }
  86
  87 sub setio {
  88     my $self = shift;
  89     my $io = shift;
  90
  91     $self->{'_OUT'} = $io;
  92 }
  93
  94 sub pushio {
  95     my $self = shift;
  96     my $io = shift;
  97
  98     push(@{$self->{'_OUTSTACK'}}, $self->{'_OUT'});
  99     $self->setio($io);
 100 }
 101
 102 sub popio {
 103     my $self = shift;
 104     my $io = pop(@{$self->{'_OUTSTACK'}});
 105
 106     if (defined($io)) {
 107         $self->setio($io);
 108     }
 109 }
 110
 111 sub getconfstr {
 112     my $self = shift;
 113     my $s = 'Options for ' . $self->{'NAME'} . ":\n";
 114     my $k;
 115     my $p;
 116
 117     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
 118         $p = $self->{'_CONFIG'}->{'option'}->{$k}->{'content'};
 119         $p =~ s/%/%%/g;
 120         $s .= sprintf("  %s: %s", $k, $p);
 121         if ($self->{'_CONFIG'}->{'option'}->{$k}->{'content'} eq $self->{'_PARAMS'}->{$k}->[0]) {
 122             $s .= " (default)\n";
 123         } else {
 124             $s .= "\n";
 125         }
 126     }
 127
 128     return $s;
 129 }
 130
 131 sub gethelpstr {
 132     my $self = shift;
 133     my $s = 'Help for ' . $self->{'NAME'} . ":\n";
 134     my $k;
 135     my $p;
 136
 137     if (exists($self->{'DESC'})) {
 138         $s .= "Description:\n " . $self->{'DESC'};
 139     }
 140
 141     $s .= " Options:\n";
 142     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
 143         $p = $self->{'_PARAMS'}->{$k}->[0];
 144         $p =~ s/%/%%/g;
 145         $s .= sprintf("  %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
 146     }
 147
 148     return $s;
 149 }
 150
 151 sub setdebug {
 152     my $self = shift;
 153
 154     $self->{'_DEBUG'} = shift;
 155 }
 156
 157 1;