File Coverage

blib/lib/POE/Component/IRC/Object.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

# $Id: Object.pm,v 1.3 2002/07/02 14:36:39 matt Exp $

package POE::Component::IRC::Object;
use strict;
use POE;
use POE::Component::IRC;

use vars qw($VERSION $AUTOLOAD);

$VERSION = '0.02';

sub new {
    my $class = shift;
    die __PACKAGE__ . "->new() params must be a hash" if @_ % 2;
    my %params = @_;

    my $self = bless \%params, $class;
    $self->init();
    return $self;
}

my $id = 0;

sub init {
    my ($self) = @_;

    my $name = sprintf("pocoirc_irc_%06d", ++$id);
    # warn("Creating IRC object $name\n");
    $self->{__IRC} = $name;
    POE::Component::IRC->new($name);

    POE::Session->create(
        object_states => [
            $self => [ '_start', '_stop', '_default' ],
        ],
    );
}

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

    # warn("_start - registering all\n");

    $kernel->post($self->{__IRC}, "register", "all");

    my $hash = {};
    $hash->{Nick} = $self->{Nick} if $self->{Nick};
    $hash->{Server} = $self->{Server} if $self->{Server};
    $hash->{Port} = $self->{Port} if $self->{Port};
    $hash->{Username} = $self->{Username} if $self->{Username};
    $hash->{Ircname} = $self->{Ircname} if $self->{Ircname};

    $kernel->post($self->{__IRC}, "connect", $hash);
}

sub _stop {
    my ($self, $kernel) = @_[OBJECT, KERNEL];
    # warn("stopping\n");
    $self->{__Quitting} = 1;
    $kernel->post($self->{__IRC}, "quit");
}

sub _default {
    my ($self, $kernel, $state, $args) = @_[OBJECT, KERNEL, ARG0, ARG1];
    my @new_ = @_[ 1 .. (ARG0-1) ];
    push @new_, @$args;
    $self->$state(@new_);
    return 0;
}

sub irc_socketerr {
    warn("irc_socket error: ", $_[ARG0], "\n");
    warn("Perhaps your server name or port is incorrect, or your net access is down\n");
}

sub AUTOLOAD {
    my $self = shift;
    my $method = $AUTOLOAD;
    $method =~ s/^.*://;
    $poe_kernel->post($self->{__IRC}, $method, @_);
}

sub irc_error {
    my ($self, $kernel, $server) = @_[OBJECT, KERNEL, ARG0];
    $self->{__irc_connected} = 0;
    $kernel->yield('reconnect');
}

sub reconnect {
    my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
    return if $heap->{__irc_connected};

    my $hash = {};
    $hash->{Nick} = $self->{Nick} if $self->{Nick};
    $hash->{Server} = $self->{Server} if $self->{Server};
    $hash->{Port} = $self->{Port} if $self->{Port};
    $hash->{Username} = $self->{Username} if $self->{Username};
    $hash->{Ircname} = $self->{Ircname} if $self->{Ircname};

    $kernel->post($self->{__IRC}, "connect", $hash);

    # try again in 2 seconds (may have succeeded, but we test that at the top
    $kernel->delay_set( 'reconnect', 2 );
}

sub irc_connected {
    $_[OBJECT]->{__irc_connected} = 1;
}

1;

__END__