# (c) 2007 by Ralf Ertzinger # licensed under GNU GPL v2 package Base; use strict; use Data::Dumper; sub new { my $class = shift; my $self = {'_DEBUG' => 0, '_OUT' => sub {print shift}, '_OUTSTACK' => []}; bless($self, $class); $self->_prepare_parameters(); return $self; } sub error { my $self = shift; my $t; $t = sprintf(shift(@_), @_); $t =~ s/%/%%/g; $self->{'_OUT'}($t); } sub debug { my $self = shift; my @data = @_; $data[0] = "DEBUG: " . $data[0]; if ($self->{'_DEBUG'} != 0) {$self->error(@data)}; } sub mergeconfig { my $self = shift; my $c = shift; my $o; return $self->{'_CONFIG'} unless defined($c); foreach $o (keys(%{$c->{'option'}})) { if (exists($self->{'_CONFIG'}->{'option'}->{$o})) { $self->{'_CONFIG'}->{'option'}->{$o}->{'content'} = $c->{'option'}->{$o}->{'content'}; } } return $self->{'_CONFIG'}; } sub _prepare_parameters { my $self = shift; my $p; $self->{'_CONFIG'} = {'option' => {'enabled' => {'content' => '1'}}}; foreach $p (keys(%{$self->{'_PARAMS'}})) { $self->{'_CONFIG'}->{'option'}->{$p}->{'content'} = $self->{'_PARAMS'}->{$p}->[0]; } } sub _getval { my $self = shift; my $key = shift; my $val; $val = $self->{'_CONFIG'}->{'option'}->{$key}->{'content'}; $self->debug('Returning %s=%s', $key, $val); return $val; } sub setval { my $self = shift; my $key = shift; my $val = shift; if (exists($self->{'_CONFIG'}->{'option'}->{$key})) { $self->{'_CONFIG'}->{'option'}->{$key}->{'content'} = $val; } else { $self->error('Module %s does not have a parameter named %s', $self->{'NAME'}, $key); } } sub setio { my $self = shift; my $io = shift; $self->{'_OUT'} = $io; } sub pushio { my $self = shift; my $io = shift; push(@{$self->{'_OUTSTACK'}}, $self->{'_OUT'}); $self->setio($io); } sub popio { my $self = shift; my $io = pop(@{$self->{'_OUTSTACK'}}); if (defined($io)) { $self->setio($io); } } sub getconfstr { my $self = shift; my $s = 'Options for ' . $self->{'NAME'} . ":\n"; my $k; my $p; foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) { $p = $self->{'_CONFIG'}->{'option'}->{$k}->{'content'}; $p =~ s/%/%%/g; $s .= sprintf(" %s: %s", $k, $p); if ($self->{'_CONFIG'}->{'option'}->{$k}->{'content'} eq $self->{'_PARAMS'}->{$k}->[0]) { $s .= " (default)\n"; } else { $s .= "\n"; } } 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"; my $k; my $p; if (exists($self->{'DESC'})) { $s .= "Description:\n " . $self->{'DESC'}; } $s .= " Options:\n"; foreach $k (keys(%{$self->{'_CONFIG'}->{'option'}})) { $p = $self->{'_PARAMS'}->{$k}->[0]; $p =~ s/%/%%/g; 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; } sub setdebug { my $self = shift; $self->{'_DEBUG'} = shift; } 1;