view release on metacpan or  search on metacpan

lib/Helm/Log/Channel/irc.pm  view on Meta::CPAN

package Helm::Log::Channel::irc;
use strict;
use warnings;
use Moose;
use namespace::autoclean;
use DateTime;
use AnyEvent;
use IO::Pipe;

BEGIN {
    eval { require AnyEvent::IRC::Client };
    die "Could not load AnyEvent::IRC::Client. It must be installed to use Helm's irc logging"
      if $@;
}

extends 'Helm::Log::Channel';
has irc_pipe    => (is => 'ro', writer => '_irc_pipe');
has pipes       => (is => 'ro', writer => '_pipes', isa => 'HashRef');
has is_parallel => (is => 'rw', isa    => 'Bool', default => 0);
has irc_pause   => (is => 'ro', writer => '_irc_pause', isa => 'Int', default => 0);
has prefix      => (is => 'rw', isa => 'Str', default => '');

my $DISCONNECT = 'Disconnecting';

# first parse the IRC URI into some parts that we can use to create an IRC connection.
# Then fork off an IRC worker process to go into an event loop that will read input
# from the main process via a pipe and then output that to the IRC server. We need
# to do it in an event loop because it needs to also respond asynchronously to the
# IRC server for pings and such.
sub initialize {
    my ($self, $helm) = @_;
    my $options = $helm->extra_options;
    my $pause = $options->{'irc-pause'} || $options->{'irc_pause'};
    $self->_irc_pause($pause) if $pause;

    my %irc_info;

    # file the file and open it for appending
    my $uri = $self->uri;
    if ($uri->authority =~ /@/) {
        my ($nick, $host) = split(/@/, $uri->authority);
        $irc_info{nick}   = $nick;
        $irc_info{server} = $host;
    } else {
        $irc_info{nick}   = 'helm';
        $irc_info{server} = $uri->authority;
    }
    $helm->die("No IRC server given in URI $uri") unless $irc_info{server};

    # get the channel
    my $channel = $uri->path;
    $helm->die("No IRC channel given in URI $uri") unless $channel;
    $channel =~ s/^\///;    # remove leading slash
    $channel = "#$channel" unless $channel =~ /^#/;
    $irc_info{channel} = $channel;

    # do we need a password
    my $query = $uri->query;
    if ($query && $query =~ /(?:^|&|;)(pass|pw|password|passw|passwd)=(.*)(?:$|&|;)/) {
        $irc_info{password} = $1;
    }

    # do we have a port?
    if ($irc_info{server} =~ /:(\d+)$/) {
        $irc_info{port} = $1;