File Coverage

blib/lib/POE/Component/IRC/Plugin/MultiProxy/ClientManager.pm

Criterion	Covered	Total	%
statement	23	131	17.5
branch	0	52	0.0
condition	0	18	0.0
subroutine	9	24	37.5
pod	2	5	40.0
total	34	230	14.7

package POE::Component::IRC::Plugin::MultiProxy::ClientManager;
BEGIN {
  $POE::Component::IRC::Plugin::MultiProxy::ClientManager::AUTHORITY = 'cpan:HINRIK';
}
BEGIN {
  $POE::Component::IRC::Plugin::MultiProxy::ClientManager::VERSION = '0.01';
}

use strict;
use warnings FATAL => 'all';
use Carp;
use POE qw(Filter::Line Filter::Stackable);
use POE::Component::IRC::Common qw( u_irc );
use POE::Component::IRC::Plugin qw( :ALL );
use POE::Filter::IRCD;

sub new {
    my ($package, %self) = @_;
    return bless \%self, $package;
}

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

    if (!$irc->isa('POE::Component::IRC::State')) {
        die __PACKAGE__ . " requires PoCo::IRC::State or a subclass thereof\n";
    }

    for my $plugin (qw(Recall State)) {
        my $full = "POE::Component::IRC::Plugin::MultiProxy::$plugin";

        if (!grep { $_->isa($full) } values %{ $irc->plugin_list() } ) {
            die __PACKAGE__ . " requires $full\n";
        }
    }

    $self->{ircd_filter} = POE::Filter::IRCD->new();
    $self->{wheels} = { };

    ($self->{state}) = grep { $_->isa('POE::Component::IRC::Plugin::MultiProxy::State') } values %{ $irc->plugin_list() };
    $self->{irc} = $irc;
    $irc->raw_events(1);
    $irc->plugin_register($self, 'SERVER', qw(raw));

    POE::Session->create(
        object_states => [
            $self => [ qw(_start _client_new _client_error _client_input _drop_client) ],
        ],
    );

    return 1;
}

sub PCI_unregister {
    my ($self, $irc) = @_;

    for my $id (keys %{ $self->{wheels} }) {
        $poe_kernel->call("$self", '_drop_client', $id);
    }
    $poe_kernel->alias_remove("$self");
    return 1;
}

sub add_client {
    my ($self, $socket) = @_;
    $poe_kernel->call("$self", '_client_new', $socket);
    return;
}

sub _start {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    $kernel->alias_set("$self");
    return;
}

sub _client_new {
    my ($self, $socket) = @_[OBJECT, ARG0];

    my $filter = POE::Filter::Stackable->new(
        Filters => [
            POE::Filter::Line->new(),
            POE::Filter::IRCD->new(),
        ]
    );

    my $wheel = POE::Wheel::ReadWrite->new(
        Handle       => $socket,
        InputFilter  => $filter,
        OutputFilter => POE::Filter::Line->new(),
        InputEvent   => '_client_input',
        ErrorEvent   => '_client_error',
    );

    $self->{wheels}{$wheel->ID} = $wheel;

    my ($recall_plug) = grep { $_->isa('POE::Component::IRC::Plugin::MultiProxy::Recall') } values %{ $self->{irc}->plugin_list() };
    $wheel->put($recall_plug->recall());
    return;
}

sub _client_error {
    my ($kernel, $wheel_id) = @_[KERNEL, ARG3];
    $kernel->yield('_drop_client', $wheel_id);
    return;
}

sub _client_input {
    my ($kernel, $self, $input, $wheel_id) = @_[KERNEL, OBJECT, ARG0, ARG1];
    my $irc   = $self->{irc};
    my $state = $self->{state};
    my $wheel = $self->{wheels}{$wheel_id};

    if ($input->{command} eq 'QUIT') {
        $kernel->yield('_drop_client', $wheel->ID);
        return;
    }
    elsif ($input->{command} eq 'PING') {
        $wheel->put('PONG'.(defined $input->{params}[0] ? " $input->{params}[0]" : ''));
        return;
    }
    elsif ($input->{command} eq 'PRIVMSG') {
        my ($recipient, $msg) = @{ $input->{params} }[0..1];
        if ($recipient =~ /^[#&+!]/) {
            # recreate channel messages from this client for
            # other clients to see
            my $line = ':' . $irc->nick_long_form($irc->nick_name()) . " PRIVMSG $recipient :$msg";

            for my $other (values %{ $self->{wheels} }) {
                next if $other->ID == $wheel->ID;
                $other->put($line);
            }
        }
    }
    elsif ($input->{command} eq 'WHO') {
        if ($input->{params}[0] && $input->{params}[0] !~ tr/*//) {
            if (!defined $input->{params}[1]) {
                if ($input->{params}[0] !~ /^[#&+!]/ || $irc->channel_list($input->{params}[0])) {
                    $state->enqueue(sub { $self->_put($wheel->ID, @_) }, 'who_reply', $input->{params}[0]);
                    return;
                }
            }
        }
    }
    elsif ($input->{command} eq 'MODE') {
        if ($input->{params}[0]) {
            my $mapping = $irc->isupport('CASEMAPPING');
            if (u_irc($input->{params}[0], $mapping) eq u_irc($irc->nick_name(), $mapping)) {
                if (!defined $input->{params}[1]) {
                    $wheel->put($state->mode_reply($input->{params}[0]));
                    return;
                }
            }
            elsif ($input->{params}[0] =~ /^[#&+!]/ && $irc->channel_list($input->{params}[0])) {
                if (!defined $input->{params}[1] || $input->{params}[1] =~ /^[eIb]$/) {
                    $state->enqueue(sub { $self->_put($wheel->ID, @_) }, 'mode_reply', @{ $input->{params} }[0,1]);
                    return;
                }
            }
        }
    }
    elsif ($input->{command} eq 'NAMES') {
        if ($irc->channel_list($input->{params}[0]) && !defined $input->{params}[1]) {
            $state->enqueue(sub { $self->_put($wheel->ID, @_) }, 'names_reply', $input->{params}[0]);
            return;
        }
    }
    elsif ($input->{command} eq 'TOPIC') {
        if ($irc->channel_list($input->{params}[0]) && !defined $input->{params}[1]) {
            $state->enqueue(sub { $self->_put($wheel->ID, @_) }, 'topic_reply', $input->{params}[0]);
            return;
        }
    }

    $irc->yield(quote => $input->{raw_line});

    return;
}

sub _drop_client {
    my ($self, $wheel_id) = @_[OBJECT, ARG0];
    my $irc = $self->{irc};

    if (delete $self->{wheels}{$wheel_id}) {
        $irc->send_event(irc_proxy_close => $wheel_id);
    }
    return;
}

sub S_raw {
    my ($self, $irc) = splice @_, 0, 2;
    my $raw_line = ${ $_[0] };
    return PCI_EAT_NONE if !keys %{ $self->{wheels} };

    my $input = $self->{ircd_filter}->get( [ $raw_line ] )->[0];
    return PCI_EAT_NONE if $input->{command} !~ /^(?:PING|PONG)/;
    $_->put($raw_line) for values %{ $self->{wheels} };
    return PCI_EAT_NONE;
}

sub _put {
    my ($self, $wheel_id, $raw_line) = @_;
    return if !defined $self->{wheels}{$wheel_id};
    $self->{wheels}{$wheel_id}->put($raw_line);
    return;
}

1;

=encoding utf8

=head1 NAME

POE::Compoent::IRC::Plugin::MultiProxy::ClientManager - A PoCo-IRC plugin which handles a proxy clients

=head1 SYNOPSIS

 use POE::Compoent::IRC::Plugin::MultiProxy::ClientManager;

 $irc->plugin_add('MultiProxyClient_1', POE::Compoent::IRC::Plugin::MultiProxy::Client->new());

=head1 DESCRIPTION

POE::Compoent::IRC::Plugin::MultiProxy::Client is a
L plugin. It handles a input/output
and disconnects from a proxy client.

This plugin requires the IRC component to be
L or a subclass thereof.

=head1 METHODS

=head2 C

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

=head2 C

Takes one argument, the socket of the new proxy client.

=head1 AUTHOR

Hinrik Ern SigurEsson, [e-mail]

=cut