File Coverage

blib/lib/Bot/Pluggable.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

# $Id: Pluggable.pm,v 1.5 2002/12/10 13:23:34 matt Exp $

package Bot::Pluggable;
use POE::Component::IRC::Object;
use base qw(POE::Component::IRC::Object);

$VERSION = '0.03';

use strict;
use POE;

sub add_module {
    my ($self, @modules) = @_;
    my %new_modules = map { $_ => 1 } (@{$self->{Modules}}, @modules);
    @{$self->{Modules}} = keys %new_modules;
}

sub remove_module {
    my ($self, @modules) = @_;
    my %new_modules = map { $_ => 1 } @{$self->{Modules}};
    foreach my $mod (@modules) { delete $new_modules{$mod} }
    @{$self->{Modules}} = keys %new_modules;
}

sub modules {
    my ($self) = @_;
    return @{$self->{Modules}};
}

sub add_object {
    my ($self, @objects) = @_;
    push @{$self->{Objects}}, @objects;
}

sub objects {
    my ($self) = @_;
    return @{$self->{Objects}};
}

BEGIN {
    sub add_event {
        my $class = shift;
        my $method = shift;
        eval "sub $method {\n" .
          '    my $self = $_[OBJECT];
               $_[SENDER] = $self;
               shift(@_);
               foreach my $obj ($self->objects) {
                 my $meth = $obj->can(' . "'$method'" . ');
                 next unless $meth;
                 my $ret = $meth->($obj, @_);
                 return if $ret;
               }
               foreach my $class ($self->modules) {
                 my $meth = $class->can(' . "'$method'" . ');
                 next unless $meth;
                 my $ret = $meth->($class, @_);
                 return if $ret;
               }
             }';
        die "Compilation of $method failed: $@" if $@;
    }

    my @methods = qw(
        irc_001
        irc_public
        irc_join
        irc_invite
        irc_kick
        irc_mode
        irc_msg
        irc_nick
        irc_notice
        irc_part
        irc_ping
        irc_quit
        irc_dcc_chat
        irc_dcc_done
        irc_dcc_error
        irc_dcc_get
        irc_dcc_request
        irc_dcc_send
        irc_dcc_start
        irc_snotice

        irc_ctcp_finger
        irc_ctcp_version
        irc_ctcp_source
        irc_ctcp_userinfo
        irc_ctcp_clientinfo
        irc_ctcp_errmsg
        irc_ctcp_ping
        irc_ctcp_time
        irc_ctcp_action
        irc_ctcp_dcc
    );

    foreach my $method (@methods) {
        __PACKAGE__->add_event($method);
    }
}

1;

__END__