POE: Cookbook - IRC A Simple Client

use strict;
use warnings;
use Getopt::Long;
use POE qw(Component::IRC::State Wheel::ReadLine);
use Data::Dumper;
$Data::Dumper::Indent = 1;
my $nick;
my $user;
my $server;
my $port;
my $ircname;
my $password;
my $current_channel;
GetOptions(
  "nick=s"    => \$nick,
  "server=s"  => \$server,
  "user=s"    => \$user,
  "port=s"    => \$port,
  "pass=s"    => \$password,
  "ircname=s" => \$ircname,
);
die unless $nick and $server;
print "$nick $server\n";
my $irc = POE::Component::IRC::State->spawn(
  Nick     => $nick,
  Server   => $server,
  Port     => $port,
  Ircname  => $ircname,
  Username => $user,
  Password => $password
);
print STDOUT $irc->version(), "\n";
POE::Session->create(package_states =>
    ['main' => [qw(_start _stop got_input parse_input _default irc_public)],],);
$poe_kernel->run();
exit 0;

sub _start {
  my $heap = $_[HEAP];
  $heap->{readline_wheel} =
    POE::Wheel::ReadLine->new(InputEvent => 'got_input');
  $heap->{readline_wheel}->get("> ");
  $irc->yield(register => 'all');
  undef;
}

sub _stop {
  delete $_[HEAP]->{readline_wheel};
  $irc->yield(unregister => 'all');
  $irc->yield('shutdown');
  undef;
}

sub got_input {
  my ($heap, $kernel, $input, $exception) = @_[HEAP, KERNEL, ARG0, ARG1];
  if (defined $input) {
    $heap->{readline_wheel}->addhistory($input);

    #$heap->{readline_wheel}->put("I heard $input");
    $kernel->yield('parse_input' => $input);
  }
  elsif ($exception eq 'interrupt') {
    $heap->{readline_wheel}->put("Goodbye.");
    delete $heap->{readline_wheel};
    $irc->yield(unregister => 'all');
    $irc->yield('shutdown');
    return;
  }
  else {
    $heap->{readline_wheel}->put("\tException: $exception");
    if ($exception eq 'eot') {
      $irc->yield(unregister => 'all');
      $irc->yield('shutdown');
      delete($heap->{readline_wheel});
    }
  }
  $heap->{readline_wheel}->get("> ") if ($heap->{readline_wheel});
  undef;
}

sub parse_input {
  my ($kernel, $heap, $input) = @_[KERNEL, HEAP, ARG0];

  # Parse input
  if ($input =~ /^\//) {
    $input =~ s/^\///;
    my (@args) = split(/ /, $input);
    my ($cmd) = shift @args;
    SWITCH: {
      if ($cmd eq 'connect') {
        if ($irc->connected()) {
          $heap->{readline_wheel}->put("Already connected");
          last SWITCH;
        }
        $heap->{readline_wheel}->put("Connecting");
        $irc->yield('connect');
        last SWITCH;
      }
      if ($cmd eq 'dump_state') {
        unless (@args) {
          $heap->{readline_wheel}->put($_)
            for split /\n/, Dumper($irc->{STATE});
        }
        else {
          open my $fh, ">", $args[0] or return;
          print $fh Dumper($irc->{STATE});
        }
        last SWITCH;
      }
      if ($cmd eq 'sl' or $cmd eq 'quote') {
        $irc->yield($cmd => join(' ', @args));
      }
      else {
        $irc->yield($cmd => @args);
      }
      $heap->{readline_wheel}->put($cmd . " " . join(' ', @args));
    }
  }
  undef;
}

sub _default {
  my ($event, $args) = @_[ARG0 .. $#_];
  my (@output);
  my $arg_number = 0;
  foreach (@$args) {
    SWITCH: {
      if (ref($_) eq 'ARRAY') {
        push(@output, "[", join(", ", @$_), "]");
        last SWITCH;
      }
      if (ref($_) eq 'HASH') {
        push(@output, "{", join(", ", %$_), "}");
        last SWITCH;
      }
      push(@output, "'$_'");
    }
    $arg_number++;
  }
  $_[HEAP]->{readline_wheel}->put("$event " . join(' ', @output))
    if (defined($_[HEAP]->{readline_wheel}));
  return 0;    # Don't handle signals.
}

sub irc_public {
  my ($kernel, $heap, $who, $where, $what) = @_[KERNEL, HEAP, ARG0, ARG1, ARG2];
  my ($nick) = (split /!/, $who)[0];
  my ($chan) = $where->[0];
  $heap->{readline_wheel}->put($chan . ':<' . $nick . '> ' . $what);
  undef;
}