File Coverage

blib/lib/App/Bondage/Client.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package App::Bondage::Client;
BEGIN {
  $App::Bondage::Client::AUTHORITY = 'cpan:HINRIK';
}

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;

our $VERSION = '1.3';

sub new {
    my ($package, %self) = @_;
    if (!$self{Socket}) {
        croak "$package requires a Socket";
    }
    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";
    }

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

    $self->{filter} = POE::Filter::IRCD->new();
    $self->{stacked} = POE::Filter::Stackable->new(
        Filters => [
            POE::Filter::Line->new(),
            POE::Filter::IRCD->new(),
        ]
    );

    ($self->{state}) = grep { $_->isa('App::Bondage::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_error _client_input) ],
        ],
    );

    return 1;
}

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

    $poe_kernel->call("$self", '_client_error');
    return 1;
}

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

    $kernel->alias_set("$self");

    $self->{wheel} = POE::Wheel::ReadWrite->new(
        Handle       => $self->{Socket},
        InputFilter  => $self->{stacked},
        OutputFilter => POE::Filter::Line->new(),
        InputEvent   => '_client_input',
        ErrorEvent   => '_client_error',
    );
    delete $self->{Socket};
    $self->{wheel_id} = $self->{wheel}->ID();

    my ($recall_plug) = grep { $_->isa('App::Bondage::Recall') } values %{ $self->{irc}->plugin_list() };
    $self->{wheel}->put($recall_plug->recall());

    return;
}

sub _client_error {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    my $irc = $self->{irc};

    if ($self->{wheel}) {
        # causes deep recursion somehow
        #$self->{wheel}->put('ERROR :Closing link (Caught interrupt)');
        #$self->{wheel}->flush();
        delete $self->{wheel};
        $irc->send_event(irc_proxy_close => $self->{wheel_id});
        $kernel->alias_remove("$self");
        $irc->plugin_del($self) if grep { $_ == $self } values %{ $irc->plugin_list() };
    }
    return;
}

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

    if ($input->{command} eq 'QUIT') {
        $irc->plugin_del($self);
        return;
    }
    elsif ($input->{command} eq 'PING') {
        $self->{wheel}->put('PONG ' . $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 $client (grep { $_->isa('App::Bondage::Client') } values %{ $irc->plugin_list() } ) {
                $client->put($line) if $client != $self;
            }
        }
    }
    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($_[0]) }, '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]) {
                    $self->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($_[0]) }, '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($_[0]) }, '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($_[0]) }, 'topic_reply', $input->{params}[0]);
            return;
        }
    }

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

    return;
}

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

    my $input = $self->{filter}->get( [ $raw_line ] )->[0];
    $self->{wheel}->put($raw_line) if $input->{command} !~ /^(?:PING|PONG)/;
    return PCI_EAT_NONE;
}

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

1;

=encoding utf8

=head1 NAME

App::Bondage::Client - A PoCo-IRC plugin which handles a proxy client.

=head1 SYNOPSIS

 use App::Bondage::Client;

 $irc->plugin_add('Client_1', App::Bondage::Client->new(Socket => $socket));

=head1 DESCRIPTION

App::Bondage::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

One argument:

B<'Socket'>, the socket of the proxy client.

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

=head2 C

One argument:

An IRC protocol line

Sends an IRC protocol line to the client

=head1 AUTHOR

Hinrik Ern SigurEsson, [e-mail]

=cut