#!/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;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.