xmlrtorrent/Base.pm

   1 # (c) 2007 by Ralf Ertzinger <ralf@camperquake.de>
   2 # licensed under GNU GPL v2
   3
   4 package xmlrtorrent::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}};
  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     foreach $p (keys(%{$self->{'_PARAMS'}})) {
  58         $self->{'_CONFIG'}->{'option'}->{$p}->{'content'} = $self->{'_PARAMS'}->{$p}->[0];
  59     }
  60 }
  61
  62 sub _getval {
  63     my $self = shift;
  64     my $key = shift;
  65     my $val;
  66
  67     $val = $self->{'_CONFIG'}->{'option'}->{$key}->{'content'};
  68     $self->debug('Returning %s=%s', $key, $val);
  69
  70     return $val;
  71 }
  72
  73 sub setval {
  74     my $self = shift;
  75     my $key = shift;
  76     my $val = shift;
  77
  78     if (exists($self->{'_CONFIG'}->{'option'}->{$key})) {
  79         $self->{'_CONFIG'}->{'option'}->{$key}->{'content'} = $val;
  80     } else {
  81         $self->error('Module %s does not have a parameter named %s', $self->{'NAME'}, $key);
  82     }
  83 }
  84
  85 sub setio {
  86     my $self = shift;
  87     my $io = shift;
  88
  89     $self->{'_OUT'} = $io;
  90 }
  91
  92 sub getconfstr {
  93     my $self = shift;
  94     my $s = 'Options for ' . $self->{'NAME'} . ":\n";
  95     my $k;
  96     my $p;
  97
  98     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
  99         $p = $self->{'_CONFIG'}->{'option'}->{$k}->{'content'};
 100         $p =~ s/%/%%/g;
 101         $s .= sprintf("  %s: %s", $k, $p);
 102         if ($self->{'_CONFIG'}->{'option'}->{$k}->{'content'} eq $self->{'_PARAMS'}->{$k}->[0]) {
 103             $s .= " (default)\n";
 104         } else {
 105             $s .= "\n";
 106         }
 107     }
 108
 109     return $s;
 110 }
 111
 112 # Return a list of the parameters supported by the module
 113 # Does not return the 'enabled' parameter
 114 sub getparamlist {
 115     my $self = shift;
 116     my $word = shift;
 117
 118     return grep {$_ ne 'enabled' && /^$word/} keys %{$self->{'_PARAMS'}};
 119 }
 120
 121 # Return a list of valid parameter values, if the parameter has
 122 # such a list.
 123 sub getparamvalues {
 124     my $self = shift;
 125     my $param = shift;
 126     my $word = shift;
 127
 128     unless(exists($self->{'_PARAMS'}->{$param}->[2])) {
 129         return ();
 130     } else {
 131         return grep {/^$word/} keys %{$self->{'_PARAMS'}->{$param}->[2]};
 132     }
 133 }
 134
 135
 136 sub gethelpstr {
 137     my $self = shift;
 138     my $s = 'Help for ' . $self->{'NAME'} . ":\n";
 139     my $k;
 140     my $p;
 141
 142     if (exists($self->{'DESC'})) {
 143         $s .= "Description:\n  " . $self->{'DESC'} . "\n";
 144     }
 145
 146     $s .= "Options:\n";
 147     foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) {
 148         $p = $self->{'_PARAMS'}->{$k}->[0];
 149         $p =~ s/%/%%/g;
 150         if (exists($self->{'_PARAMS'}->{$k}->[2])) {
 151             # The parameter has a list of allowed values. Add the keys and their help
 152             $s .= sprintf("  %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
 153             foreach (sort keys(%{$self->{'_PARAMS'}->{$k}->[2]})) {
 154                 $s .= sprintf("     %s: %s\n", $_, $self->{'_PARAMS'}->{$k}->[2]->{$_});
 155             }
 156         } else {
 157             # The parameter just has a default value and a help text
 158             $s .= sprintf("  %s: %s (default: %s)\n", $k, $self->{'_PARAMS'}->{$k}->[1], $p);
 159         }
 160     }
 161
 162     return $s;
 163 }
 164
 165 sub setdebug {
 166     my $self = shift;
 167
 168     $self->{'_DEBUG'} = shift;
 169 }
 170
 171 1;