File Coverage

blib/lib/Business/WebMoney/Exchanger.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Business::WebMoney::Exchanger;

use 5.008000;
use strict;
use warnings;

use Business::WebMoney;

our $VERSION = '0.02';

use Carp;
use LWP::UserAgent;
use XML::LibXML;
use HTTP::Request;

sub new
{
	my ($class, @args) = @_;

	my $opt = Business::WebMoney::parse_args(\@args, {
		timeout => 20,
	});

	my $self = {
		timeout => $opt->{timeout},
	};

	return bless $self, $class;
}

sub best_rates
{
	my ($self, @args) = @_;

	$self->{errstr} = undef;
	$self->{errcode} = undef;

	my $req_fields = Business::WebMoney::parse_args(\@args, {
		debug_response => undef,
	});

	my $res = eval {

		local $SIG{__DIE__};

		my $res_content;

		unless ($res_content = $req_fields->{debug_response}) {

			my $ua = LWP::UserAgent->new;
			$ua->timeout($self->{timeout});
			$ua->env_proxy;

			my $req = HTTP::Request->new;
			$req->method('GET');
			$req->uri('https://wm.exchanger.ru/asp/XMLbestRates.asp');

			my $res = $ua->request($req);

			unless ($res->is_success) {

				$self->{errcode} = $res->code;
				$self->{errstr} = $res->message;
				return undef;
			}

			$res_content = $res->content;
		}

		my $parser = XML::LibXML->new;

		my $doc = $parser->parse_string($res_content);

		my %result;

		for my $node ($doc->getElementsByTagName('row')) {

			my ($from, $to, %row);

			for my $attr ($node->attributes) {

				my $key = $attr->name;
				my $value = $attr->value;

				if ($key eq 'Direct') {

					($from, $to) = ($value =~ /^(\S+?)\s*-\s*(\S+)$/);

				} elsif ($key eq 'BaseRate') {

					$row{rate} = ($value > 0) ? ($value + 0) : (-1 / $value);

				} elsif (my ($percent) = ($key =~ /^Plus(\d+)$/)) {

					# 005 => 0.05
					# 01 => 0.1
					# 02 => 0.2
					# ...
					# 1 => 1
					# 2 => 2
					# ...
					$percent =~ s/^0(0*)/0.$1/;

					$row{$percent} = $value;

				} else {

					$row{$key} = $value;
				}
			}

			if ($from && $to && $row{rate}) {

				$result{$from}->{$to} = \%row;
			}
		}

		\%result;
	};

	if ($@) {

		$self->{errcode} = -1000;
		$self->{errstr} = $@;
		return undef;
	}

	return $res;
}

sub errcode
{
	my ($self) = @_;

	return $self->{errcode};
}

sub errstr
{
	my ($self) = @_;

	return $self->{errstr};
}

1;

__END__