#!/usr/bin/perl
######
# Copyright (C) 2003 Brent Garber
#
#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+, USA.
#####


use warnings;
use strict;

use POE;
use POE::Component::IRC;
use POE::Component::Client::HTTP;
use XML::Simple;
use HTTP::Request::Common qw(GET POST);
use HTML::Entities;
use HTML::Scrubber;
use URI::Escape;
use HTTP::Cookies;
$|=1;

my %GLOBAL = (
    nick => 'CBRelay',
    server => 'irc.remnetworks.org', 
    port => '6667',
    username => 'PMRelay',
    ircname => 'I relay chat: PerlMonksCB <-> remnetworks',
    chan => '#PerlMonks',
    XMLURL => 'http://www.perlmonks.com/index.pl?node_id=207304',
);

$GLOBAL{scrubber} = HTML::Scrubber->new(
    rules => [a => { href => 1, '*' => 0 } ],
    default => '0',
);
$GLOBAL{cookie} = HTTP::Cookies->new( file => "$ENV{'HOME'}/lwp_cookie
+s.dat",
    autosave => 1,
 );
POE::Component::IRC->new('remnet') or die "Can't create new: $!\n";
POE::Component::Client::HTTP->spawn( Alias => 'ua', );
POE::Component::Client::HTTP->spawn( Alias => 'pm', CookieJar => $GLOB
+AL{cookie}, );

POE::Session->new ( 
    _start         => \&bot_start,
    irc_001     => \&on_connect,
    irc_public    => \&on_public,
    irc_notice    => \&on_notice,
    irc_msg        => \&on_priv,
    get_xml     => \&get_xml,    
    got_response    => \&got_response,
    login_response    => \&login_response,
    post_response    => \&post_response,
);

sub bot_start {
    my $kernel     = $_[KERNEL];
    my $heap    = $_[HEAP];
    my $session    = $_[SESSION];

    $kernel->post( remnet => register => "all" );


    $kernel->post( remnet => connect =>
        { Nick         => "$GLOBAL{nick}",
        Username    => "$GLOBAL{username}",
        Ircname     => "$GLOBAL{ircname}",
        Server    => "$GLOBAL{server}",
        Port        => "$GLOBAL{port}",
        }
    );
    get_xml();
    $kernel->delay('get_xml', 20);

}

sub on_connect {
    $_[KERNEL]->post( remnet => join => "$GLOBAL{chan}" );
}

sub on_priv {
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 
+];
    my $nick = ( split /!/, $who )[0];
    print "I got message from $nick\n";
    $GLOBAL{cookie}->clear;
    $GLOBAL{cookie}{COOKIES}{'www.perlmonks.com'}{'/'}{'userpass'} = $
+GLOBAL{users}{$nick}{cookie};
    if($GLOBAL{users}{$nick}{cookie}) {
        print "$nick wants to send $msg\n";
        $msg = uri_escape($msg);
        my $url = 'http://www.perlmonks.com/index.pl?node_id=2518&op=m
+essage&message=' . $msg . '&message_send=talk';
        $kernel->post( pm => request => post_response => GET $url );
    } else {
        print "Not logged in\n";
    }
}

sub on_notice {
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 
+];
    my $nick = ( split /!/, $who )[0];
    if($msg =~ /^\!login\s+(.+?)\s+(.+)/) { 
        print "$nick wants to login with user: $1 and password: $2\n";
        my $user = $1;
        my $password = $2;
        my $url = 'http://www.perlmonks.com/index.pl?node_id=236515&op
+=login&user=' . $user . '&passwd=' . $password . '&ircnick=' . $nick;
        $kernel->post( pm => request => login_response => GET $url );
    }    
}

sub on_public {
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 
+];
    my $nick = ( split /!/, $who )[0];
    my $channel = $where->[0];

    my $ts = scalar(localtime);
    if ( $msg =~ /^data/ ) {
        foreach(@{$GLOBAL{xml}{message}}) { 
            my $messageid = $_->{message_id}[0];
            next if $GLOBAL{lastid} && $messageid <= $GLOBAL{lastid};
            format_text($_->{text}[0]);
            my $message = "<$_->{author}[0]> $_->{text}[0]\n";
            $kernel->post( remnet => privmsg => $GLOBAL{chan}, $messag
+e );
        }
        if($GLOBAL{xml}{message}->[0]->{message_id}[0]) { 
            $GLOBAL{lastid} = $GLOBAL{xml}{message}->[-1]->{message_id
+}[0]; 
        }
    }
}

sub send_message {
    foreach(@{$GLOBAL{xml}{message}}) {
        my $messageid = $_->{message_id}[0];
        next if $GLOBAL{lastid} && $messageid <= $GLOBAL{lastid};
        my $text = format_text($_->{text}[0]);
        my $message = "$_->{author}[0]: $text\n";
        $poe_kernel->post( remnet => privmsg => $GLOBAL{chan}, $messag
+e );
    }
    if($GLOBAL{xml}{message}->[0]->{message_id}[0]) {
        $GLOBAL{lastid} = $GLOBAL{xml}{message}->[-1]->{message_id}[0]
+;
    }
}

sub format_text {
    my $text = $_[0];
    decode_entities($text);
    $text = $GLOBAL{scrubber}->scrub($text);
    return $text;
}

sub post_response {
    print "Post Response\n";
    my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, 
+ARG1 ];
    
    my $http_response = $response_packet->[0];
}

sub got_response {
    my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, 
+ARG1 ];

    my $http_request  = $request_packet->[0];
    my $http_response = $response_packet->[0]{_content};

    $GLOBAL{xml} = XMLin($http_response, ForceArray => 'message');
    send_message();
    $poe_kernel->delay('get_xml', 20);
}

sub login_response {
    print "Login\\Post Response\n";
    my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, 
+ARG1 ];
    
    my $http_request = $request_packet->[0];
    my $http_response = $response_packet->[0];
    my $irc = $request_packet->[0]{_uri};
    $irc =~ /ircnick\=(.+)/i;
    $irc = $1;
    chomp($irc);
    $GLOBAL{users}{$irc}{cookie} = [ @{$GLOBAL{cookie}{COOKIES}{'www.p
+erlmonks.com'}{'/'}{'userpass'}} ];
}

sub get_xml {
    $poe_kernel->post( ua => request => got_response => GET $GLOBAL{XM
+LURL} );
}

$poe_kernel->run();
exit 0;
[download]