package POE::Component::IRC::Tracking;

=head1 NAME

POE::Component::IRC::Tracking

=head1 SYNOPSIS

    use POE qw( Component::IRC::Tracking );
    
    POE::Component::IRC::Tracking->new("alias");
    ...See perldoc POE::Component::IRC...
    
    my $botheap = POE::Kernel->alias_resolve("alias")->get_heap;
    
    # $botheap->{connected} is true if the bot's connected.
    my $connected = $botheap->{connected};
    
    # $botheap->{nick} is the current nickname of the bot.
    my $nick = $botheap->{nick};
    
    # $botheap->{channels} is a hashref whose keys are the channels
    # the bot is on.
    my @channels = $connected ? keys %{ $botheap->{channels} } : ();

=head1 DEPENDENCY

POE::Component::IRC::Tracking isa subclass of POE::Component::IRC.

=head1 DESCRIPTION

POE::Component::IRC::Tracking adds tracking support to POE::Component:
+:IRC,
i.e. the bot knows its current nick and the channels it joined.

Use it exactly like POE::Component::IRC.

=head1 AUTHOR

Ingo Blechschmidt, L<mailto:iblech@web.de>.

=head1 LICENSE

This package is free software; you can redistribute it and/or modify i
+t under
the same terms as Perl itself, i.e., under the terms of the GNU Genera
+l Public
License of the Artistic License.

=cut

use warnings;
use strict;

use POE;
use base "POE::Component::IRC";

# We've to keep track of the traffic we got. That's necessary for auto
+ping and
# livecheck. Additionally, we update our nick.
sub _parseline {
  my $line = $_[ARG0];

  # Hackery.
  # 
  # :thestars.gnus 001 nick :Welcome to the Internet Relay Network nic
+k!~a@thestars.gnus
  # :thestars.gnus 376 nick :End of MOTD command.
  # 
  # Why do we do this? "You *are* already recording the nick! [see C<c
+onnect>
  # and C<irc_433> subs]" But: If the nick we NICKed to is too long fo
+r the
  # server, it's silently cut off. We can't know that. So, we update o
+ur
  # information from the server, which is guaranteed to be correct.
  if($line =~ /^:[^ ]+ (?:001|376) ([^ ]+) :/) {
    $_[HEAP]->{nick} = $1;
  }

  # We received some data, record that.
  $_[HEAP]->{last_traffic} = time;

  $_[0]->SUPER::_parseline(@_[1..$#_]);
}

# We ping the server if we haven't seen any traffic for 60s.
use constant AUTOPING_INTERVAL => 60 * 1;
# A connection is considered dead if we haven't seen any traffic von 5
+min.
use constant CONNDEAD_TIMEOUT  => 60 * 5;

sub _start {
  $_[0]->SUPER::_start(@_[1..$#_]);

  # We have to register some eventhandler.
  POE::Kernel->state(autoping  => \&bot_autoping);
  POE::Kernel->state(livecheck => \&bot_livecheck);
  POE::Kernel->state(irc_001   => \&irc_001);
  POE::Kernel->state(irc_433   => \&irc_433);
  POE::Kernel->state(irc_join  => \&irc_join);
  POE::Kernel->state(irc_part  => \&irc_part);
  POE::Kernel->state(irc_kick  => \&irc_kick);
  POE::Kernel->state(irc_nick  => \&irc_nick);

  # And, we have to register our interest.
  POE::Kernel->yield(register  => qw( 001 433 join part kick nick ));

  # We check every 10s if we've seen traffic for AUTOPING_INTERVAL sec
+onds.
  POE::Kernel->delay_set(autoping  => 10);
  # A connection is considered dead after CONNDEAD_TIMEOUT seconds.
  POE::Kernel->delay_set(livecheck => 10);
}

sub connect {
  $_[0]->SUPER::connect(@_[1..$#_]);

  # Our nick.
  my $nick = $_[HEAP]->{nick};

  # $_[HEAP]->nickgen is a coderef which returns our nick pre- or post
+fixed
  # with C<_>s at each invocation (nick, nick_, _nick, etc.).
  $_[HEAP]->{nickgen} = $_[0]->permute_nick($nick);

  # $_[HEAP]->{channels} is a hashref which contains channel names as 
+keys. If
  # $_[HEAP]->{channels}->{"#parrot"} is true, the bot is in #parrot.
  $_[HEAP]->{channels} = {};

  # livecheck would kill our connection if we don't "lie" about the
  # last_traffic seen.
  $_[HEAP]->{last_traffic} = time;
}

# If we haven't seen traffic for AUTOPING_INTERVAL seconds, we ping th
+e server.
sub bot_autoping {
  # There should be only one "instance" of autoping.
  POE::Kernel->alarm_remove( $_[HEAP]->{autoping_id} ) if $_[HEAP]->{a
+utoping_id};

  if(
    # We have to know the server's name (not the hostname).
    defined $_[HEAP]->{irc_servername} and
    # We can only PING if we're connected
    $_[HEAP]->{connected} and
    # PING only, if we haven't seen traffic for AUTOPING_INTERVAL seco
+nds.
    time - $_[HEAP]->{last_traffic} >= AUTOPING_INTERVAL
  ) {
    POE::Kernel->yield(sl_login => "PING :" . $_[HEAP]->{irc_servernam
+e});
  }

  # Check again in 10s.
  $_[HEAP]->{autoping_id} = POE::Kernel->delay_set(autoping => 10);
}

# Properly mark the connection as disconnected if it's stalled.
sub bot_livecheck {
  # There should be only one "instance" of livecheck.
  POE::Kernel->alarm_remove( $_[HEAP]->{livecheck_id} ) if $_[HEAP]->{
+livecheck_id};

  # If we haven't seen traffic for CONNDEAD_TIMEOUT seconds...
  if(
    $_[HEAP]->{connected} and
    time - $_[HEAP]->{last_traffic} >= CONNDEAD_TIMEOUT
  ) {
    POE::Kernel->yield(sl_login => "QUIT");
    $_[HEAP]->{connected} = 0;
  }

  # Check again in 10s.
  $_[HEAP]->{livecheck_id} = POE::Kernel->delay_set(livecheck => 10);
}

sub irc_001 {
  # ARG0 contains the name of the server. We have to store that in ord
+er to be
  # able to autoping.
  $_[HEAP]->{irc_servername} = $_[ARG0];
}

# 433: Nick taken.
sub irc_433 {
  # So, we take the next permuted nick.
  my $new = $_[HEAP]->{nickgen}->();

  POE::Kernel->yield(nick => $new);
  $_[HEAP]->{nick} = $new;
}

# irc_join is triggered whenever somebody joins a channel.
sub irc_join {
  my ($mask, $channel) = @_[ARG0, ARG1];
  # If the thing which joined is something without a nick (e.g. a
  # pseudo-server, etc.), skip.
  $mask =~ /^([^!]+)/ or return;

  # $1 is the nickname of the person who joined.
  if($1 eq $_[HEAP]->{nick}) {
    # We joined $channel.
    $_[HEAP]->{channels}->{$channel}++;
  }
}

# irc_part is triggered whenever somebody parts a channel.
sub irc_part {
  my ($mask, $channel) = @_[ARG0, ARG1];
    $channel =~ /^([^ ]+) ?:?(.*)/;
    ($channel, my $why) = ($1, defined $2 ? $2 : "");
    # Because of a bug in PoCo::IRC (author notified), the PART messag
+e gets
    # concatenated with the channel name. We have to strip that out.

  # Same thing like above, if the "person" who joined is special, skip
+.
  $mask =~ /^([^!]+)/ or return;

  if($1 eq $_[HEAP]->{nick}) {
    # We left $channel.
    delete $_[HEAP]->{channels}->{$channel};
  }
}

# irc_kick is triggered whenever somebody is kicked off a channel.
sub irc_kick {
  my ($kicker, $channel, $kicked, $why) = @_[ARG0 .. $#_];
  # Again, skip special things.
  $kicked =~ /^([^!]+)/ or return;
  
  if($1 eq $_[HEAP]->{nick}) {
    # We were kicked from $channel.
    delete $_[HEAP]->{channels}->{$channel};
  }
}

# irc_nick is triggered whenever somebody changes his nick.
sub irc_nick {
  my ($mask, $new) = @_[ARG0, ARG1];

  # ...Skip special things...
  $mask =~ /^([^!]+)/ or return;

  if($1 eq $_[HEAP]->{nick}) {
    # We changed our nick.
    $_[HEAP]->{nick} = $new;
  }
}

# Input:  A nick
# Output: A coderef which returns the nick permuted upon invocation.
sub permute_nick {
  my $n = $_[1];

  my @nicks = split /\s+/, <<NICKS;
${n}
${n}_   _${n}   _${n}_
${n}__  __${n}  __${n}__
_${n}__ __${n}_
${n}___ ___${n} ___${n}___
NICKS
  # Ok, that's enough... :-)

  sub {
    my $nick = shift @nicks;
    push @nicks, $nick;
    return $nick;
  };
}

package main;

unless(caller) {
  # A small demo, straightforward.
  # The bot joins #test1,#test2,#test3 when it's online.
  # Every 3s it'll display some status information.
  # KICK or KILL him, the bot will update his status accordingly.

  POE::Session->create(inline_states => {
    _start => sub {
      POE::Component::IRC::Tracking->new("bot");
      POE::Kernel->post("bot", register => qw( 376 join ));
      POE::Kernel->post("bot", connect => {
    Server => "thestars",
    Nick   => "testlongnicktestlongnick",
      });
    },

    # End of /MOTD, e.g.: We're inside.
    irc_376 => sub {
      warn "Inside.\n";
      local $_;
      POE::Kernel->post("bot", join => $_) for "#test1", "#test2", "#t
+est3";
      POE::Kernel->delay_set(info => 3);
    },

    info => sub {
      # We should add nice C<POE::Kernel::call>able events to query th
+is
      # information.
      my $heap = POE::Kernel->alias_resolve("bot")->get_heap;

      if($heap->{connected}) {
    warn "We are on:   " . join(", ", keys %{ $heap->{channels} }) . "
+\n";
    warn "Our nick is: " . $heap->{nick} . "\n";
      } else {
    warn "Not connected.\n";
      }

      POE::Kernel->delay_set(info => 3);
    },
  });

  POE::Kernel->run;
}

1;
[download]