File Coverage

blib/lib/POE/Component/IRC/Plugin/BotAddressed.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	9	16	56.2
condition	2	3	66.6
subroutine	9	9	100.0
pod	1	5	20.0
total	76	88	86.3

package POE::Component::IRC::Plugin::BotAddressed;
$POE::Component::IRC::Plugin::BotAddressed::VERSION = '6.95';
use strict;
use warnings FATAL => 'all';
use Carp;
use POE::Component::IRC::Plugin qw( :ALL );

sub new {
    my ($package) = shift;
    croak "$package requires an even number of arguments" if @_ & 1;
    my %args = @_;

    $args{lc $_} = delete $args{$_} for keys %args;
    return bless \%args, $package;
}

sub PCI_register {
    my ($self, $irc) = splice @_, 0, 2;
    $irc->plugin_register( $self, 'SERVER', qw(ctcp_action public) );
    return 1;
}

sub PCI_unregister {
    return 1;
}

sub S_ctcp_action {
    my ($self, $irc) = splice @_, 0, 2;
    my $who = ${ $_[0] };
    my $recipients = ${ $_[1] };
    my $what = ${ $_[2] };
    my $me = $irc->nick_name();
    my $chantypes = join('', @{ $irc->isupport('CHANTYPES') || ['#', '&']});

    my $eat = PCI_EAT_NONE;
    return $eat if $what !~ /$me/i;

    for my $recipient (@{ $recipients }) {
        if ($recipient =~ /^[$chantypes]/) {
            $eat = PCI_EAT_ALL if $self->{eat};
            $irc->send_event_next(irc_bot_mentioned_action => $who => [$recipient] => $what);
        }
    }

    return $eat;
}

sub S_public {
    my ($self, $irc) = splice @_, 0, 2;
    my $who = ${ $_[0] };
    my $channels = ${ $_[1] };
    my $what = ${ $_[2] };
    my $me = $irc->nick_name();
    my ($cmd) = $what =~ m/^\s*[@%]?\Q$me\E[:,;.!?~]?\s*(.*)$/i;

    return PCI_EAT_NONE if !defined $cmd && $what !~ /$me/i;

    for my $channel (@{ $channels }) {
        if (defined $cmd) {
            $irc->send_event_next(irc_bot_addressed => $who => [$channel] => $cmd );
        }
        else {
            $irc->send_event_next(irc_bot_mentioned => $who => [$channel] => $what);
        }
    }

    return $self->{eat} ? PCI_EAT_ALL : PCI_EAT_NONE;
}

1;

=encoding utf8

=head1 NAME

POE::Component::IRC::Plugin::BotAddressed - A PoCo-IRC plugin that generates
events when you are addressed

=head1 SYNOPSIS

 use POE::Component::IRC::Plugin::BotAddressed;

 $irc->plugin_add( 'BotAddressed', POE::Component::IRC::Plugin::BotAddressed->new() );

 sub irc_bot_addressed {
     my ($kernel, $heap) = @_[KERNEL, HEAP];
     my $nick = ( split /!/, $_[ARG0] )[0];
     my $channel = $_[ARG1]->[0];
     my $what = $_[ARG2];

     print "$nick addressed me in channel $channel with the message '$what'\n";
 }

 sub irc_bot_mentioned {
     my ($nick) = ( split /!/, $_[ARG0] )[0];
     my ($channel) = $_[ARG1]->[0];
     my ($what) = $_[ARG2];

     print "$nick mentioned my name in channel $channel with the message '$what'\n";
 }

=head1 DESCRIPTION

POE::Component::IRC::Plugin::BotAddressed is a
L plugin. It watches for public
channel traffic (i.e. C and C) and will generate
an C, C or C
event if its name comes up in channel discussion.

=head1 METHODS

=head2 C

One optional argument:

B<'eat'>, set to true to make the plugin eat the C /
C
event and only generate an appropriate event, default is false.

Returns a plugin object suitable for feeding to
L's C method.

=head1 OUTPUT EVENTS

=head2 C

Has the same parameters passed as L|POE::Component::IRC/irc_public>.
C contains the message with the addressed nickname removed, ie. Assuming
that your bot is called LameBOT, and someone says 'LameBOT: dance for me',
you will actually get 'dance for me'.

=head2 C

Has the same parameters passed as L|POE::Component::IRC/irc_public>.

=head2 C

Has the same parameters passed as L|POE::Component::IRC/irc_ctcp_*>.

=head1 AUTHOR

Chris 'BinGOs' Williams

=cut