##########[ ircpipe starts here  ]##########
#!/usr/bin/perl

use warnings;
use strict;

use Fcntl qw( :DEFAULT :flock );
use Getopt::Long;

# The FIFO ircpiped listens on.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my ($server, $to);
my $help;

my $ok = GetOptions(
  "fifo=s"   => \$fifo,
  "server=s" => \$server,
  "to=s"     => \$to,
  "help"     => \$help
);

if(!$ok or !$server or !$to or $help) {
  print STDERR <<USAGE;
ircpipe -- Trigger ircpiped to send a message

Usage: $0 [--fifo=~/.ircpipe.fifo] [--help] --server=host[:port] --to=
+#channel [files]

Options:
  --fifo=~/.ircpipe.fifo      Sets the FIFO ircpiped listens on.
                              Important: ircpiped has to be started
                  using the same FIFO.
  --help                      Displays this message.
  --server=host[:port]        Sets the server to connect to. port defa
+ults to
                  6667.
  --to=#channel or            Sets the recipient.
  --to=nick

Non-option arguments are taken to be filenames which should be sent. I
+f no
file's specified, ircpipe reads from STDIN.

Options may be abbreviated to uniqueness.
USAGE
  exit;
}

# Default $port to 6667.
my ($host, $port) = split /:/, $server;
$port ||= 6667;

# Open the FIFO and lock it exclusively. See perldoc -q lock.
sysopen my $fh, $fifo, O_RDWR|O_CREAT
  or die "Couldn't open $fifo: $!\n";
flock $fh, LOCK_EX
  or die "Couldn't flock $fifo: $!\n";

while(<>) {
  chomp;
  print $fh join(":", $host, $port, $to, $_) . "\n"
    or die "Couldn't write to $fifo: $!\n"
}

close $fh
  or die "Couldn't close $fifo: $!";

exit;
##########[ ircpipe ends here    ]##########
##########[ ircpiped starts here ]##########
#!/usr/bin/perl

use warnings;
use strict;

use POE   qw( Wheel::FollowTail );
use POSIX qw( strftime );
use Term::ANSIColor
      qw( color );
use Getopt::Long;

# Hash of Bot objects
my %bot;

# FIFO and nick to use.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my $nick = "ircpipe";

# Need help?
my $help;

# Hackery: $verbose is global, so our package Bot has access to it, to
+o.
our $verbose;

my $ok = GetOptions(
  "fifo=s"  => \$fifo,
  "nick=s"  => \$nick,
  "help"    => \$help,
  "verbose" => \$verbose
);

if(!$ok or $help) {
  print STDERR <<USAGE;
ircpiped -- Daemon part of ircpipe

Usage: $0 [--fifo=~/.ircpipe.fifo] [--nick=ircpipe] [--verbose] [--hel
+p]

Options:
  --fifo=~/.ircpipe.fifo     Sets the FIFO to listen on
  --nick=ircpipe             Sets the nick to use
  --verbose                  Be verbose
  --help                     Displays this message

Options may be abbreviated to uniqueness.
USAGE
  exit;
}

POE::Session->create(
  inline_states => {
    _start => \&fifo_start,
    got    => \&fifo_got,
  },
);

POE::Kernel->run;
exit;

# Nice formatting... But only if the user set --verbose.
sub info ($) {
  printf STDERR "[%s%s%s] %s%s%s: %s%s%s\n",
    color("bold white"),
    strftime("%d.%m.%y/%H:%M:%S", localtime),
    color("reset"),
    color("bold yellow"),
    "fifo",
    color("reset"),
    color("bold magenta"),
    $_[0],
    color("reset")
    if $verbose or $_[1];
}

sub fifo_start {
  info "Listening on named pipe $fifo...";
  $_[HEAP]->{fifo} = POE::Wheel::FollowTail->new(
    Filename   => $fifo,
    InputEvent => "got",
  );
}

sub irc_start {
  # This sub fires up a Bot. Bot::new expects the hostname, portnumber
+, and
  # nickname to use as parameters. $_[0] is sth. like "thestars:6667",
+ so we've
  # to split it.
  $bot{$_[0]} = Bot->new(split(/:/, $_[0]), $nick);
}

sub fifo_got {
  my $line = $_[ARG0];

  # Example input line:
  #   thestars:6667:#channel:Hello
  $line =~ /^([^:]+):([^:]+):([^:]+):(.+)$/ or do {
    info "Malformed input line: \"$line\"";
    return;
  };
  my ($server, $to, $msg) = ("$1:$2", $3, $4);

  # Fire up a Bot if not already done.
  $bot{$server} or irc_start($server);

  # Connect to the server if not already done.
  $bot{$server}->connected or $bot{$server}->connect;

  # Join if not already joined.
  $bot{$server}->joined($to) or $bot{$server}->join($to)
    if $to =~ /^[#&+]/;

  # Send.
  $bot{$server}->privmsg($to => $msg);
}

package Bot;

use warnings;
use strict;

use POE   qw( Component::IRC::Tracking );
use POSIX qw( strftime );
use Term::ANSIColor
        qw( color );
use Text::Wrap
      qw( wrap);

# IRCNAME is the realname information shown in /WHOIS
use constant IRCNAME           => "POE::Component::IRC::Tracking power
+ed ircpipe";
# 255 is the historical line length limit. "PRIVMSG #to :" counts too,
+ so we
# say 200 and are likely safe.
use constant MAX_SEND_LEN      => 200;

# Nice formatting... But only if the user set --verbose.
sub info {
  my ($self, $msg, $force) = @_;

  printf STDERR "[%s%s%s] %s%s%s@%s%s%s: %s%s%s\n",
    color("bold white"),
    strftime("%d.%m.%y/%H:%M:%S", localtime),
    color("reset"),
    color("bold yellow"),
    $self->botheap->{nick} || "no nick",
    color("reset"),
    color("bold red"),
    $self->server,
    color("reset"),
    color("bold magenta"),
    $msg,
    color("reset")
    if $::verbose or $force;
}

sub new {
  my ($class, $host, $port, $nick) = @_;
  my $self = bless [] => $class;
  local $_;

  ($self->host, $self->port, $self->server, $self->nick) =
    ($host, $port, "$host:$port", $nick);

  # $self->perform is an arrayref of coderefs which are executed upon 
+reception
  # of 376 (End of /MOTD).
  $self->perform = [];

  $self->sid = POE::Session->create(
    object_states => [
      $self => {
        _start  => "bot_start",
        connect => "bot_connect",

    # We don't *need* those events, they're mostly only for debugging.
    map {($_)x2} qw(
      irc_connected irc_376
      irc_ctcp_ping
      irc_invite irc_474
      irc_socketerr irc_disconnected
    ),
      },
    ],
  )->ID;

  return $self;
}

# C<botheap> returns the HEAP of PoCo::IRC::Tracking
sub botheap { POE::Kernel->alias_resolve($_[0]->bot)->get_heap }

# Are we connected?
sub connected { $_[0]->botheap->{connected} and $_[0]->seen_376 }

# Are we on channel C<$_[1]>?
sub joined { $_[0]->connected and $_[0]->botheap->{channels}->{$_[1]} 
+}

# Join a channel.
sub join {
  my ($self, $chan) = @_;
  return if $self->joined($chan);

  if($self->connected) {
    # If we're connected, join.
    $self->info("Joining $chan...");
    POE::Kernel->post($self->bot, sl_login => "JOIN $chan");

  } else {
    # If not, we've to queue the join.
    # $self->perform is an arrayref of coderefs which are executed upo
+n
    # reception of 376 (End of /MOTD).
    push @{ $self->perform }, sub { $self->join($chan) };
  }
}

# Send a msg.
sub privmsg {
  my ($self, $to, $msg) = @_;

  if($self->connected) {
    # Same game as above, send immediately if we're connected, else qu
+eue.
    $self->info("Sending \"$msg\" to $to...");

    # Why local? As soon as this block is left, the original values ar
+e
    # recovered. So, if the programmer uses Text::Wrap, we don't reset
+ his
    # settings.
    local $Text::Wrap::columns = MAX_SEND_LEN;
    local $Text::Wrap::huge    = "wrap";

    # Ok, send...
    local $_;
    POE::Kernel->post($self->bot, sl_login => "PRIVMSG $to :$_")
      for split /\n/, wrap("", "", $msg);
  } else {
    # Queue.

    push @{ $self->perform }, sub { $self->privmsg($to => $msg) };
  }
}

sub bot_start {
  my $self = $_[OBJECT];

  # Fire up the bot...
  POE::Component::IRC::Tracking->new($self->bot = "bot/$self");
  # $self->bot keeps the alias of the PoCo.
  
  # ...and register all events. We don't need all, this is mainly for
  # convenience.
  POE::Kernel->post($self->bot, register => "all");
}

# This sub wraps the POE event in a nice OO method.
sub connect { POE::Kernel->post($_[0]->sid, connect => @_[1..$#_]) }

sub bot_connect {
  my $self = $_[OBJECT];

  $self->info("Connecting...");
  POE::Kernel->post($self->bot, connect => {
    Server   => $self->host,
    Port     => $self->port,
    Nick     => $self->nick,
    Username => $self->nick,
    Ircname  => IRCNAME,
  });

  # $self->seen_376 is true if we received End of /MOTD, e.g. if we're
+ inside.
  # Reset it for now.
  $self->seen_376 = 0;
}

# We get this event if the socket is successfully connected.
sub irc_connected {
  my $self = $_[OBJECT];

  $self->info("Socket connected.");
}

# 376: End of /MOTD.
# Process $self->perform.
sub irc_376 {
  my $self = $_[OBJECT];

  $self->info("Inside (got 376 event).");
  # Set $senf->seen_376 to a true value.
  $self->seen_376++;

  local $_;
  &$_ for splice @{ $self->perform };
  # splice @array returns @array and empties it.
}

# We are banned?
sub irc_474 {
  my $self = $_[OBJECT];

  my $msg = $_[ARG1];
  $msg =~ /^([^ ]+) :(.*)$/ or return;

  $self->info("Couldn't join channel $1: \"$2\"");
}

# Answer to CTCP PINGs.
sub irc_ctcp_ping {
  my $self = $_[OBJECT];

  my ($mask, undef, $ping) = @_[ARG0..$#_];
  $self->info("Got CTCP-PINGed from $mask.");

  # Don't answer to "special things" (thing without a nickname).
  $mask =~ /^([^!]+)/ or return;

  # Why don't we use PoCo::IRC's ctcp_reply here?
  # Reason: We want the PING-reply to be sent out as soon as possible.
  # PoCo::IRC's default priority of ctcp_reply is too low.
  POE::Kernel->post($self->bot, sl_login => "NOTICE $1 :\001PING $ping
+\001");
}

# Accept invitations.
sub irc_invite {
  my $self = $_[OBJECT];

  $self->info("Got invitation to $_[ARG1] from $_[ARG0].");
  $self->join($_[ARG1]);
}

# The connection got lost, notify the user.
sub irc_socketerr    { $_[0]->info("Socket error.") }
sub irc_disconnected { $_[0]->info("Connection lost.") }

sub host     : lvalue { $_[0]->[0] }
sub port     : lvalue { $_[0]->[1] }
sub server   : lvalue { $_[0]->[2] }
sub nick     : lvalue { $_[0]->[3] }
sub sid      : lvalue { $_[0]->[4] }
sub bot      : lvalue { $_[0]->[5] }
sub perform  : lvalue { $_[0]->[6] }
sub seen_376 : lvalue { $_[0]->[7] }

# That's all.

1;
#########[ ircpiped ends here   ]##########