view release on metacpan or  search on metacpan

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

            $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];
    my $irc = $_[SENDER]->get_heap();
    $self->_event_debug($irc, [@_[ARG0..$#_]], 'S_plugin_del') if $self->{trace};
    $self->_status($irc, 'normal', "Deleted plugin $alias");
    return;
}

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