All pastes #75133 Raw Edit

Unnamed

public text v1 · immutable
#75133 ·published 2006-06-29 20:34 UTC
rendered paste body
package Trivia::Bot::Plugins;
# some code from CPAN's Bot::Pluggable
use warnings;
use strict;
use POE;
use Trivia::Bot::Body;
use base 'Trivia::Bot::Body';
use Data::Dumper;
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}};
}

sub add_event {
    print Dumper(\@_);
    my $class = shift;
    my $method = shift;
    # --> DEBUG <--
    my $self = $_[OBJECT];
    print $self;
    foreach my $object ($self->objects) {
        next unless $object->can($method);
        my $return = eval "return $object->$method($object, @_);";
        warn $@ if $@;
        return if $return;
    }
    foreach my $module ($self->modules) {
        next unless $module->can($method);
        my $return = eval "return $module->$method($module, @_);";
        warn $@ if $@;
        return if $return;
    }
    # END
# ->> REDACTED <<-
#  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 $@;
# END
}

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_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;