#!/usr/bin/perl

use warnings;
use strict;

# All the modules we need...
use POE;
use POE::Component::Server::TCP;
use POE::Component::Client::HTTP;
use HTTP::Request;
use XML::Simple;

# URL of the chatterbox XML feed
use constant PMCB => "http://www.perlmonks.org/index.pl?node_id=207304
+";
# Port to listen on
use constant PORT => 6668;
# Check above URL every ... seconds
use constant UPDATE_INTERVAL => 120;

# Spawn a new PoCoCl::HTTP session to fetch the XML feed
POE::Component::Client::HTTP->spawn(
        Agent           => "POE PMCM2IRCD",
        Alias           => "http",
        Streaming       => 0,
        FollowRedirects => 5
);

POE::Session->create(
        inline_states => {
                _start => sub {
                        $_[KERNEL]->alias_set("pmcb");
                        # MSGID of newest message seen
                        $_[HEAP]->{last} = 0;
                        # Hash of session-id => event-handler pairs, w
+here to send new msgs to
                        $_[HEAP]->{watchers} = {};
                        $_[KERNEL]->yield("update");
                },
                update => sub {
                        # Fetch XML feed, but only if we have clients 
+connected!
                        $_[KERNEL]->post(http => "request", updated =>
+ HTTP::Request->new(GET => PMCB))
                                if(keys %{ $_[HEAP]->{watchers} });
                        $_[KERNEL]->delay(update => UPDATE_INTERVAL);
                },
                updated => sub { eval {
                        my $struct = XML::Simple::XMLin($_[ARG1]->[0]-
+>content);

                        foreach my $msg (@{ $struct->{message} }) {
                                # We've already seen this msg.
                                next if($msg->{message_id} <= $_[HEAP]
+->{last});

                                # Maybe it's a new newest msg?
                                $_[HEAP]->{last} = $msg->{message_id} 
+if($msg->{message_id} > $_[HEAP]->{last});

                                # Filter out any newlines.
                                $msg->{text} =~ s/[\012\015]//g;

                                # For debugging purposes.
                                print "<$msg->{author}> $msg->{text}\n
+";

                                # Broadcast to clients.
                                foreach my $id (keys %{ $_[HEAP]->{wat
+chers} }) {
                                        $_[KERNEL]->post($id => $_[HEA
+P]->{watchers}->{$id}, $msg->{author} => $msg->{text});
                                }
                        }
                }},
                # Add or remove a watcher
                add_watch => sub { $_[HEAP]->{watchers}->{$_[SENDER]->
+ID} = $_[ARG0] },
                del_watch => sub { delete $_[HEAP]->{watchers}->{$_[SE
+NDER]->ID} }
        }
);

POE::Component::Server::TCP->new(
        Port => PORT,
        ClientInput => sub {
                # Basic IRC handshake:
                # NICK mynick
                # USER [...]
                # :server 001 mynick :Hi!
                # :server 376 mynick :End of /MOTD # Some clients use 
+the 376-response as i'm-now-logged-in-indicator

                for($_[ARG0]) {
                        # Remember chosen nick.
                        /^NICK (.+)$/i and $_[HEAP]->{nick} = $1, last
+;

                        # Disconnect client.
                        /^QUIT/i       and $_[KERNEL]->yield("shutdown
+"), last;

                        # Answer PING requests.
                        /^PING/i       and $_[HEAP]->{client}->put(":s
+erver PONG server :$_[HEAP]->{nick}"), last;

                        # Force-join user into #perlmonkscb and regist
+er interest on new msgs.
                        /^USER/i       and
                                $_[KERNEL]->post(pmcb => "add_watch", 
+"new_msg"),
                                $_[HEAP]->{client}->put(split /\n/, <<
+HELLO), last;
:server 001 $_[HEAP]->{nick} :Hi!
:server 376 $_[HEAP]->{nick} :End of /MOTD
:$_[HEAP]->{nick}!cloaked\@cloaked JOIN :#perlmonkscb
:server 332 $_[HEAP]->{nick} #perlmonkscb :Perlmonks chatterbox -- vis
+it http://www.perlmonks.org/
HELLO
                }
        },

        # Client disconnected -- delete watcher.
        ClientDisconnected => sub { $_[KERNEL]->post(pmcb => "del_watc
+h") },
        ClientError        => sub { $_[KERNEL]->post(pmcb => "del_watc
+h") },

        InlineStates => {
                # Send client a new msg.
                new_msg => sub {
                        $_[HEAP]->{client}->put(
                                sprintf ":%s!cloaked\@cloaked PRIVMSG 
+#perlmonkscb :%s",
                                $_[ARG0],
                                $_[ARG1]
                        )
                }
        }
);

print STDERR "Up and running.\n";
POE::Kernel->run;
[download]