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;
		}