File Coverage

blib/lib/POE/Component/IRC/Plugin/WWW/XKCD/AsText.pm

Criterion	Covered	Total	%
statement	15	99	15.1
branch	0	30	0.0
condition	0	9	0.0
subroutine	5	15	33.3
pod	1	6	16.6
total	21	159	13.2

package POE::Component::IRC::Plugin::WWW::XKCD::AsText;

use warnings;
use strict;

our $VERSION = '0.003';

use Carp;
use POE qw(Component::WWW::XKCD::AsText);
use POE::Component::IRC::Plugin qw(:ALL);

sub new {
    my $package = shift;
    croak "Even number of arguments must be specified"
        if @_ & 1;
    my %args = @_;
    $args{ lc $_ } = delete $args{ $_ } for keys %args;

    # fill in the defaults
    %args = (
        debug            => 0,
        auto             => 1,
        response_event   => 'irc_xkcd',
        banned           => [],
        addressed        => 1,
        eat              => 1,
        trigger          => qr/^xkcd\s+(?=\S)/i,
        listen_for_input => [ qw(public notice privmsg) ],

        %args,
    );

    $args{listen_for_input} = {
        map { $_ => 1 } @{ $args{listen_for_input} || [] }
    };

    return bless \%args, $package;
}

sub _start {
    my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
    $self->{_session_id} = $_[SESSION]->ID();
    $kernel->refcount_increment( $self->{_session_id}, __PACKAGE__ );

    $self->{poco} = POE::Component::WWW::XKCD::AsText->spawn(
        debug => $self->{debug},
    );

    undef;
}

sub PCI_register {
    my ( $self, $irc ) = splice @_, 0, 2;

    $self->{irc} = $irc;

    $irc->plugin_register( $self, 'SERVER', qw(public notice msg) );

    $self->{_session_id} = POE::Session->create(
        object_states => [
            $self => [
                qw(
                    _start
                    _shutdown
                    _xkcd_done
                )
            ],
        ],
    )->ID;

    return 1;
}

sub _shutdown {
    my ($kernel, $self) = @_[ KERNEL, OBJECT ];
    $self->{poco}->shutdown;
    $kernel->alarm_remove_all();
    $kernel->refcount_decrement( $self->{_session_id}, __PACKAGE__ );
    undef;
}

sub PCI_unregister {
    my $self = shift;

    # Plugin is dying make sure our POE session does as well.
    $poe_kernel->call( $self->{_session_id} => '_shutdown' );

    delete $self->{irc};

    return 1;
}

sub S_public {
    my ( $self, $irc ) = splice @_, 0, 2;
    my $who     = ${ $_[0] };
    my $channel = ${ $_[1] }->[0];
    my $message = ${ $_[2] };
    return $self->_parse_input( $irc, $who, $channel, $message, 'public' );
}

sub S_notice {
    my ( $self, $irc ) = splice @_, 0, 2;
    my $who     = ${ $_[0] };
    my $channel = ${ $_[1] }->[0];
    my $message = ${ $_[2] };
    return $self->_parse_input( $irc, $who, $channel, $message, 'notice' );
}

sub S_msg {
    my ( $self, $irc ) = splice @_, 0, 2;
    my $who     = ${ $_[0] };
    my $channel = ${ $_[1] }->[0];
    my $message = ${ $_[2] };
    return $self->_parse_input( $irc, $who, $channel, $message, 'privmsg' );
}

sub _parse_input {
    my ( $self, $irc, $who, $channel, $message, $type ) = @_;

    warn "Got input: [ who => $who, channel => $channel, "
            . "mesage => $message ]"
        if $self->{debug};

    return PCI_EAT_NONE
        unless exists $self->{listen_for_input}{ $type };

    my $what;
    if ( $self->{addressed} and $type eq 'public' ) {
        my $my_nick = $irc->nick_name();
        ($what) = $message =~ m/^\s*\Q$my_nick\E[\:\,\;\.]?\s*(.*)$/i;
    }
    else {
        $what = $message;
    }

    return PCI_EAT_NONE
        unless defined $what and $what =~ s/$self->{trigger}//;

    $what =~ s/^\s+|\s+$//;

    return PCI_EAT_NONE
            unless length $what and $what !~ /\D/;

    warn "Matched trigger: [ who => $who, channel => $channel, "
            . "what => $what ]"
        if $self->{debug};

    foreach my $ban_re ( @{ $self->{banned} || [] } ) {
        return PCI_EAT_NONE
            if $who =~ /$ban_re/;
    }

    $self->{poco}->retrieve( {
            session     => $self->{_session_id},
            event       => '_xkcd_done',
            id          => $what,
            _who        => $who,
            _channel    => $channel,
            _message    => $message,
            _type       => $type,
        }
    );

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

sub _xkcd_done {
    my ( $kernel, $self, $in_ref ) = @_[ KERNEL, OBJECT, ARG0 ];

    my $response_message;

    if ( exists $in_ref->{error} ) {
        $response_message = [ $in_ref->{error} ];
    }
    else {
        $response_message = $in_ref->{text};
        $response_message =~ s/\n\s*\n/\n \n/g;
        $response_message = [ split /\n/, $response_message ];
    }

    $self->{irc}->send_event( $self->{response_event} => {
            text => $in_ref->{text},
            id   => $in_ref->{id},
            map { $_ => $in_ref->{"_$_"} }
                qw( who channel  message  type ),
        }
    );

    if ( $self->{auto} ) {
        my $response_type = $in_ref->{_type} eq 'public'
                        ? 'privmsg'
                        : $in_ref->{_type};

        my $where = $in_ref->{_type} eq 'public'
                ? $in_ref->{_channel}
                : (split /!/, $in_ref->{_who})[0];

        for ( @$response_message ) {
            $kernel->post( $self->{irc} =>
                $response_type =>
                $where =>
                $_
            );
        }
    }

    undef;
}

1;

__END__