view release on metacpan or  search on metacpan

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

package App::Pocosi;
BEGIN {
  $App::Pocosi::AUTHORITY = 'cpan:HINRIK';
}
BEGIN {
  $App::Pocosi::VERSION = '0.03';
}

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

# we want instant child process reaping
sub POE::Kernel::USE_SIGCHLD () { return 1 }

use App::Pocosi::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 Net::Netmask;
use POE;
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::Server::IRC::Plugin',
        );
        for my $plugin (sort $self->_available_plugins()) {
            $plugin =~ s/^POE::Component::Server::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. Pocosi already running?\n";
        print $fh "$$\n";
        close $fh;
    }

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

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

                }
                push @netmasks, $netmask;
            }
            $oper->{ipmask} = \@netmasks;
        }

        $ircd->add_operator(%$oper);
    }
    return;
}

sub _add_peers {
    my ($self) = @_;
    my $ircd = $self->{ircd};
    my $peers = $self->{cfg}{peers};
    return if !defined $peers;
    $ircd->add_peer(%$_) for @$peers;
    return;
}

sub _add_auths {
    my ($self) = @_;
    my $ircd = $self->{ircd};
    my $auths = $self->{cfg}{auths};
    return if !defined $auths;
    $ircd->add_auth(%$_) for @$auths;
    return;
}

sub _add_listeners {
    my ($self) = @_;
    my $ircd = $self->{ircd};
    my $listeners = $self->{cfg}{listeners};
    return if !defined $listeners;
    $ircd->yield('add_listener', %$_) for @$listeners;
    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, $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('debug', "$event: ".join(', ', @output));
    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 ircd_plugin_add {
    my ($self, $alias) = @_[OBJECT, ARG0];
    $self->_event_debug([@_[ARG0..$#_]], 'IRCD_plugin_add') if $self->{trace};
    $self->_status('normal', "Added plugin $alias");
    return;
}

sub ircd_plugin_del {
    my ($self, $alias) = @_[OBJECT, ARG0];
    $self->_event_debug([@_[ARG0..$#_]], 'IRCD_plugin_del') if $self->{trace};
    $self->_status('normal', "Deleted plugin $alias");
    return;
}

sub ircd_plugin_error {
    my ($self, $error) = @_[OBJECT, ARG0];
    $self->_event_debug([@_[ARG0..$#_]], 'IRCD_plugin_error') if $self->{trace};
    $self->_status('error', $error);
    return;
}

sub ircd_plugin_status {
    my ($self, $plugin, $type, $status) = @_[OBJECT, ARG0..ARG2];
    my $ircd       = $_[SENDER]->get_heap();
    my $plugins    = $ircd->plugin_list();
    my %plug2alias = map { $plugins->{$_} => $_ } keys %$plugins;

    if (ref $plugin ne 'App::Pocosi::Status') {
        $status = "[$plug2alias{$plugin}] $status";
    }
    $self->_status($type, $status);
    return;
}

sub ircd_shutdown {