#!/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_cookies.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 => $GLOBAL{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=message&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}, $message );
		}
		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}, $message );
	}
	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.perlmonks.com'}{'/'}{'userpass'}} ];
}

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

$poe_kernel->run();
exit 0;