File Coverage

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

Criterion	Covered	Total	%
statement	15	107	14.0
branch	0	44	0.0
condition	0	27	0.0
subroutine	5	14	35.7
pod	0	6	0.0
total	20	198	10.1

package POE::Component::IRC::Plugin::BaseWrap;

use warnings;
use strict;

our $VERSION = '1.001001'; # VERSION

use Carp;
use POE;
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;

    my $self = bless {}, $package;
    # fill in the defaults
    %args = (
        debug            => 0,
        auto             => 1,
        response_event   => 'irc_basewrap',
        banned           => [],
        addressed        => 1,
        eat              => 1,
        response_types   => {
            public      => 'public',
            privmsg     => 'privmsg',
            notice      => 'notice',
        },
        listen_for_input => [ qw(public notice privmsg) ],

        $self->_make_default_args,

        %args,
    );

    $args{response_types}{public}  ||= 'public';
    $args{response_types}{privmsg} ||= 'privmsg';
    $args{response_types}{notice}  ||= 'notice';

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

    for ( keys %{ $args{triggers} } ) {
        if ( $_ ne 'public' and $_ ne 'notice' and $_ ne 'privmsg' ) {
            croak "Invalid key [$_] in {triggers}, must be either"
                . " 'public', 'privmsg' or 'notice'";
        }
    }

    if ( not exists $args{trigger} and ref $args{triggers} ne 'HASH' ) {
        croak "Neither 'trigger' nor 'triggers' arguments were specified";
    }

    $self->{ $_ } = delete $args{ $_ } for keys %args;

    return $self;
}

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

    $self->{irc} = $irc;

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

    return 1;
}

sub PCI_unregister {
    my $self = shift;

    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;

    return PCI_EAT_NONE
        unless (
            ( exists $self->{triggers}{ $type }
                and $what =~ s/$self->{triggers}{$type}//
            )
            or
            ( exists $self->{trigger} and $what =~ s/$self->{trigger}// )
    );

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

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

    if ( exists $self->{root} ) {
        return PCI_EAT_NONE
            unless grep { $who =~ /$_/ } @{ $self->{root} || [] };
    }

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

    $self->_do_response( {
            what       => $what,
            who        => $who,
            channel    => $channel,
            message    => $message,
            type       => $type,
        }
    );

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

sub _do_response {
    my ( $self, $in_ref ) = @_;

    my $response_message = $self->_make_response_message( $in_ref );

    my $event_response;
    if ( my $key = $self->_message_into_response_event( $in_ref ) ) {
        if ( ref $key eq 'ARRAY' ) {
            $in_ref->{ $key->[0] } = $response_message;
            %$in_ref = (
                %$in_ref,
                %{ $key->[1] },
            );
        }
        else {
            $in_ref->{ $key } = $response_message;
        }
        $event_response = $in_ref;
    }
    else {
        $event_response = $self->_make_response_event( $in_ref );
    }

    $self->{irc}->send_event(
        $self->{response_event} => $event_response,
    );

    if ( $self->{auto} ) {
        $in_ref->{type} = $self->{response_types}{ $in_ref->{type} };

        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 (
            ref $response_message eq 'ARRAY' ? @$response_message
            : ( $response_message )
        ) {
            $poe_kernel->post( $self->{irc} =>
                $response_type =>
                $where =>
                $_
            );
        }
    }

    undef;
}

sub _message_into_response_event { undef; }

1;

__END__