view release on metacpan or  search on metacpan

Amethyst/Brain/Infobot/Module/Exchange.pm  view on Meta::CPAN

package Amethyst::Brain::Infobot::Module::Exchange;

use strict;
use vars qw(@ISA
		%CODE2CODE %TLD2CODE %CURR2CODE %COUNTRY2CODE
		%CODE2CURR
				$REFERER $CONVERTER);
use Data::Dumper;
use POE;
use POE::Component::Client::UserAgent;
use HTTP::Request::Common;
use HTTP::Response;
use LWP::UserAgent;	# For init
use Amethyst::Message;
use Amethyst::Brain::Infobot;
use Amethyst::Brain::Infobot::Module;

@ISA = qw(Amethyst::Brain::Infobot::Module);

sub new {
	my $class = shift;
	my $self = $class->SUPER::new(
					Name		=> 'Exchange',
					Regex		=> qr/^(?:ex)?change\s+(\d+)\s+(\w+)\s+(?:into|to|for)\s+(\w+)/x,
					Usage		=> '(ex)?change 100 USD for DEM',
					Description	=> "Convert currencies",
					@_
						);

	return bless $self, $class;
}

sub init {
	my $self = shift;

	eval { spawn POE::Component::Client::UserAgent; };
	if ($@) {
		die $@ unless $@ =~ /^alias is in use by another session/;
	}

	$REFERER = 'http://www.xe.net/ucc/full.shtml';
	$CONVERTER ='http://www.xe.net/ucc/convert.cgi';

	my $ua = new LWP::UserAgent;
	my $uri = new URI($REFERER);
	my $request = new HTTP::Request(GET => $uri);

	print STDERR "Requesting $uri\n";

	my $response = $ua->request($request);

	unless ($response->is_success) {
		print STDERR $response->error_as_HTML;
		die "Failed to contact currency converter";
	}

	my $html = $response->content;
	$html =~ s|.*<SELECT[^>]*>(.*?)</SELECT.*|$1|s;

	my @data =
			map {
				[ $_ =~ /=\"([^\"]+)\">(.*?)(?:,\s*(.*?))? \(...\)</g ]
			}
			grep /\S/,
			split /\n/, $html;

	%CURR2CODE = map { defined $_->[2]
					? (lc $_->[2] => uc $_->[0])
					: () } @data;
	%COUNTRY2CODE = map { lc $_->[1] => uc $_->[0] } @data;
	%CODE2CODE = map { lc $_->[0] => uc $_->[0] } @data;

	%CODE2CURR = reverse %CURR2CODE;

TLD:
	while (<DATA>) {
		chomp;

		my ($tld, $country) = split /\s+/, $_, 2;
		if (exists $COUNTRY2CODE{lc $country}) {
			$TLD2CODE{lc $tld} = $COUNTRY2CODE{lc $country};
			next TLD;
		}

		($tld, $country) = split /\s+/, $_, 3;
		if (exists $COUNTRY2CODE{lc $country}) {
			$TLD2CODE{lc $tld} = $COUNTRY2CODE{lc $country};
			next TLD;
		}

		# print STDERR "Unable to identify $_\n";
	}
}

sub action {
    my ($self, $message, $number, $from, $to) = @_;

	$from = lc $from;
	$to = lc $to;

	my @all = (keys %CODE2CODE, keys %CURR2CODE, keys %COUNTRY2CODE,
	keys %TLD2CODE);

	print STDERR join(", ", sort @all);

	my $fcode = $CODE2CODE{$from}

Amethyst/Brain/Infobot/Module/Exchange.pm  view on Meta::CPAN

	my %states = map { $_ => "handler_$_" } qw(
					_start response
						);

	print STDERR "Creating child session for exchange\n";

	POE::Session->create(
		package_states	=> [ ref($self) => \%states ],
		args			=> [ $self, $message, $number, $fcode, $tcode ],
			);

	return 1;
}

sub handler_response {
	my ($kernel, $heap, $session, $pbargs) =
					@_[KERNEL, HEAP, SESSION, ARG1];
	my ($request, $response, $entry) = @$pbargs;

	unless ($response->is_success) {
		my $reply = $heap->{Module}->reply_to($heap->{Message},
						"HTTP Request failed");
		$reply->send;
		print STDERR $response->error_as_HTML;
		return;
	}

	my $html = $response->content;

	unless ($html =~ /Live Rates.*\+1><B>([^\n]*)\n(?:.*)\+1><B>([^\n]*)/si)
	{
		my $reply = $heap->{Module}->reply_to($heap->{Message},
						"Failed to parse response");
		$reply->send;
		print STDERR $response->content;
		return;
	}

	my $out = "$1 = $2";
	$out =~ s/<.*?>/ /g;
	$out =~ s/\s+/ /g;

	my $reply = $heap->{Module}->reply_to($heap->{Message}, $out);
	$reply->send;
}

sub handler__start {
	my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
	my ($module, $message, $number, $fcode, $tcode) = @_[ARG0..$#_];

	$heap->{Module} = $module;
	$heap->{Message} = $message;

	my $uri = new URI($CONVERTER);
	$uri->query_form(
			From		=> $fcode,
			To			=> $tcode,
			Amount		=> $number,
				);
	$uri = $uri->canonical;
	my $request = new HTTP::Request(GET => $uri);
	$request->referer($REFERER);

	my $postback = $session->postback('response');

	$kernel->post('useragent', 'request',
					request		=> $request,
					response	=> $postback,
						);
}

1;

__DATA__
AF	AFGHANISTAN
AL	ALBANIA
DZ	ALGERIA
AS	AMERICAN SAMOA
AD	ANDORRA
AO	ANGOLA
AI	ANGUILLA
AQ	ANTARCTICA
AG	ANTIGUA AND BARBUDA
AR	ARGENTINA
AM	ARMENIA
AW	ARUBA
AU	AUSTRALIA
AT	AUSTRIA
AZ	AZERBAIJAN
BS	BAHAMAS
BH	BAHRAIN
BD	BANGLADESH
BB	BARBADOS
BY	BELARUS
BE	BELGIUM
BZ	BELIZE
BJ	BENIN
BM	BERMUDA
BT	BHUTAN
BO	BOLIVIA
BA	BOSNIA AND HERZEGOWINA
BW	BOTSWANA
BV	BOUVET ISLAND
BR	BRAZIL
IO	BRITISH INDIAN OCEAN TERRITORY
BN	BRUNEI DARUSSALAM
BG	BULGARIA
BF	BURKINA FASO
BI	BURUNDI
KH	CAMBODIA
CM	CAMEROON
CA	CANADA
CV	CAPE VERDE
KY	CAYMAN ISLANDS
CF	CENTRAL AFRICAN REPUBLIC
TD	CHAD
CL	CHILE
CN	CHINA
CX	CHRISTMAS ISLAND
CC	COCOS (KEELING) ISLANDS
CO	COLOMBIA