All pastes #505586 Raw Edit

Something

public text v1 · immutable
·published 2007-05-23 17:27 UTC
rendered paste body
package Anna::Config;
use strict;
use warnings;

our @EXPORT = qw();
our @EXPORT_OK = qw();
use Exporter;
our @ISA = qw(Exporter);

use Carp;


## new
# Params: configuration options
# Return a blessed reference to an empty configuration hash
sub new {
        my $class = shift;
        croak "$class requires an even number of parameters" if @_ & 1;

        # Get parameters from caller
        my %params = @_;
        foreach (keys %params) {
                $params{ lc($_) } = delete $params{$_};
        }

        # Create an empty config-hash
        my $conf = {
                server          => undef,
                port            => undef,
                nick            => undef,
                username        => undef,
                channel         => undef,
                name            => undef,
                nspasswd        => undef,
                dbfile          => undef,
                colour          => undef,
                silent          => undef,
                verbose         => undef,
                log             => undef,
                trigger         => undef,
                bannedwords     => [],
                voice_auth      => undef
        };

        # Fill it with caller's params
        foreach (keys %$conf) {
                $$conf{$_} = $params{$_} if defined $params{$_};
        }

        return bless $conf, $class;
}

## parse_configfile
# Params: path to configfile
# Return a reference to an object, holding the configuration details.
sub parse_configfile {
        my ($self, $cfile) = @_;
        croak "Missing parameter" unless defined $cfile;
        unless (-r $cfile) {
                printf "%s does not exist or is not readable", $cfile;
                return $self;
        }
        open(CFG, "<".$cfile) or croak(main::error("Can't open configuration file ".$cfile.": ".$!));
        while(<CFG>) {
                next if (/^#/ || /^\[/ || /^$/);
                if (/^(.*?)\s*=\s*(.*)$/) {
                        # Server part
                        $self->set('server', $2) if (lc($1) eq 'server');
                        $self->set('port', $2) if (lc($1) eq 'port');
                        $self->set('nick', $2) if (lc($1) eq 'nickname');
                        $self->set('username', $2) if (lc($1) eq 'username');
                        $self->set('channel', $2) if (lc($1) eq 'channel');
                        $self->set('name', $2) if (lc($1) eq 'ircname');
                        $self->set('nspasswd', $2) if (lc($1) eq 'nspasswd');
                        # Script part
                        $self->set('dbfile', $2) if (lc($1) eq 'dbfile');
                        $self->set('colour', $2) if (lc($1) eq 'colour');
                        $self->set('silent', $2) if (lc($1) eq 'silent');
                        $self->set('verbose', $2) if (lc($1) eq 'verbose');
                        $self->set('log', $2) if (lc($1) eq 'logging');
                        # Bot part
                        $self->set('trigger', $2) if (lc($1) eq 'trigger');
                        if (lc($1) eq 'bannedwords') {
                                foreach (split ' ', $2) {
                                        push @{$self->{'bannedwords'}}, $_;
                                }
                        }
                        $self->set('voice_auth', $2) if (lc($1) eq 'voice_auth');
#                       $require_ops = $2 if (lc($1) eq 'require op');
#                       $require_voice = $2 if (lc($1) eq 'require voice');
                } else {
                        print warning("Syntax error in configuration file (".$cfile.") line ".$.) unless ($self->get('silent'));
                }
        }
        close(CFG);
        return $self;
}

## set
# Params: key, value
# Sets a given key to a given value.
# Returns the value
sub set {
        my $self = shift;
        my ($k, $v) = @_;
        croak "set require two parameters" unless defined $k && defined $v;

        $self->{$k} = $v;
}

## get
# Params: key
# Returns the current value for the given key, undef if key wasn't found
sub get {
        my ($self, $k) = @_;
        croak "get requires one parameter" unless defined $k;

        return $self->{$k} if defined $self->{$k};
        undef;
}
1;