Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Chatterbox2IRC bridge using POE and XML::Simple

by iblech (Friar)
on Jun 10, 2004 at 20:17 UTC ( #363177=sourcecode: print w/ replies, xml ) Need Help??

Category: PerlMonks.org Related Scripts
Author/Contact Info Ingo Blechschmidt iblech@web.de
Description: This program acts as an IRC server to broadcast the Perlmonks chatterbox to clients.
On connect, every client is force-joined into #perlmonkscb. List of /NAMES or /WHOIS, /WHO etc. don't work.
Note: Some clients (e.g. Konversation) detect the lag by /MSGing themselves. This, obviously, won't work. Other clients (irssi) use the supported PING command.
The parsing work is done by XML::Simple, POE is responsible for the networking stuff.
#!/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;

Comment on Chatterbox2IRC bridge using POE and XML::Simple
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://363177]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (4)
As of 2015-07-05 15:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (67 votes), past polls