view release on metacpan or  search on metacpan

lib/App/Pocoirc.pm  view on Meta::CPAN

package App::Pocoirc;
BEGIN {
  $App::Pocoirc::AUTHORITY = 'cpan:HINRIK';
}
{
  $App::Pocoirc::VERSION = '0.47';
}

use strict;
use warnings FATAL => 'all';

use App::Pocoirc::Status;
use Class::Load qw(try_load_class);
use Fcntl qw(O_CREAT O_EXCL O_WRONLY);
use File::Glob ':glob';
use File::Spec::Functions 'rel2abs';
use IO::Handle;
use IRC::Utils qw(decode_irc);
use POE;
use POE::Component::Client::DNS;
use POSIX 'strftime';
use Scalar::Util 'looks_like_number';

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

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

    # we print IRC output, which will be UTF-8
    binmode $_, ':utf8' for (*STDOUT, *STDERR);

    if ($self->{list_plugins}) {
        require Module::Pluggable;
        Module::Pluggable->import(
            sub_name    => '_available_plugins',
            search_path => 'POE::Component::IRC::Plugin',
        );
        for my $plugin (sort $self->_available_plugins()) {
            $plugin =~ s/^POE::Component::IRC::Plugin:://;
            print $plugin, "\n";
        }
        return;
    }

    $self->_setup();

    if ($self->{check_cfg}) {
        print "The configuration is valid and all modules could be compiled.\n";
        return;
    }

    if ($self->{daemonize}) {
        require Proc::Daemon;
        eval {
            Proc::Daemon::Init->();
            if (defined $self->{log_file}) {
                open STDOUT, '>>:encoding(utf8)', $self->{log_file}
                    or die "Can't open $self->{log_file}: $!\n";
                open STDERR, '>>&STDOUT' or die "Can't redirect STDERR: $!\n";
                STDOUT->autoflush(1);
            }
            $poe_kernel->has_forked();
        };
        chomp $@;
        die "Can't daemonize: $@\n" if $@;
    }

    if (defined $self->{pid_file}) {
        sysopen my $fh, $self->{pid_file}, O_CREAT|O_EXCL|O_WRONLY
            or die "Can't create pid file or it already exists. Pocoirc already running?\n";
        print $fh "$$\n";
        close $fh;
    }

    POE::Session->create(
        object_states => [
            $self => [qw(
                _start
                sig_die

lib/App/Pocoirc.pm  view on Meta::CPAN

    return $secondary if $success;

    chomp $error if defined $error;
    push @err, $error;

    my $class = "$primary or $secondary";
    if (@err == 2) {
        if ($err[0] =~ /^Can't locate / && $err[1] !~ /^Can't locate /) {
            $class = $secondary;
            shift @err;
        }
        elsif ($err[1] =~ /^Can't locate / && $err[0] !~ /^Can't locate /) {
            $class = $primary;
            pop @err;
        }
    }
    my $reason = join "\n", map { "  $_" } @err;
    die "Failed to load class $class:\n$reason\n";
}

sub _register_plugins {
    my ($self, $session_id, $own, $global, $local) = @_;

    for my $entry (@{ $self->{ircs} }) {
        my ($network, $irc) = @$entry;
        $self->_status($network, 'normal', 'Registering plugins');

        for my $plugin (@$own, @$global, @{ $local->{$network} }) {
            my ($name, $object) = @$plugin;
            $irc->plugin_add("${name}_$session_id", $object,
                network => $network,
            );
        }
    }

    return;
}

sub _dump {
    my ($arg) = @_;

    if (ref $arg eq 'ARRAY') {
        my @elems;
        for my $elem (@$arg) {
            push @elems, _dump($elem);
        }
        return '['. join(', ', @elems) .']';
    }
    elsif (ref $arg eq 'HASH') {
        my @pairs;
        for my $key (keys %$arg) {
            push @pairs, [$key, _dump($arg->{$key})];
        }
        return '{'. join(', ', map { "$_->[0] => $_->[1]" } @pairs) .'}';
    }
    elsif (ref $arg) {
        require overload;
        return overload::StrVal($arg);
    }
    elsif (defined $arg) {
        return $arg if looks_like_number($arg);
        return "'".decode_irc($arg)."'";
    }
    else {
        return 'undef';
    }
}

sub _event_debug {
    my ($self, $irc, $args, $event) = @_;

    if (!defined $event) {
        $event = (caller(1))[3];
        $event =~ s/.*:://;
    }

    my @output;
    for my $i (0..$#{ $args }) {
        push @output, "ARG$i: " . _dump($args->[$i]);
    }
    $self->_status($irc, 'debug', "$event: ".join(', ', @output));
    return;
}

# let's log this if it's preventing us from logging in
sub irc_432_or_433 {
    my $self = $_[OBJECT];
    my $irc = $_[SENDER]->get_heap();
    my $reason = decode_irc($_[ARG2]->[1]);
    return if $irc->logged_in();
    my $nick = $irc->nick_name();
    $self->_status($irc, 'normal', "Login attempt failed: $reason");
    return;
}

# fetch the server name if we're not using a config file
sub irc_network {
    my ($self, $sender, $network) = @_[OBJECT, SENDER, ARG0];
    my $irc = $sender->get_heap();

    for my $idx (0..$#{ $self->{ircs} }) {
        if ($self->{ircs}[$idx][1] == $irc) {
            $self->{ircs}[$idx][0] = $network;
            last;
        }
    }
    return;
}

# we handle plugin status messages here because the status plugin won't
# see these for previously added plugins or plugin_del for itself, etc
sub irc_plugin_add {
    my ($self, $alias) = @_[OBJECT, ARG0];
    my $irc = $_[SENDER]->get_heap();
    $self->_event_debug($irc, [@_[ARG0..$#_]], 'S_plugin_add') if $self->{trace};
    $self->_status($irc, 'normal', "Added plugin $alias");
    return;
}

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