The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;

use lib 't';

use Test::More tests => 37;
use Finance::Currency::Convert::XE;

###########################################################

my $CHECK_DOMAIN    = 'www.xe.com';

my %format_tests = (
	'GBP' => {	'text'		=> qr/\d+\.\d+ Great Britain, Pound/,
				'symbol'	=> qr/£\d+\.\d+/,
				'abbv'		=> qr/\d+\.\d+ GBP/ },
	'EUR' => {	'text'		=> qr/\d+\.\d+ Euro/,
				'symbol'	=> qr/€\d+\.\d+/,
				'abbv'		=> qr/\d+\.\d+ EUR/ },
	'ZMK' => {	'text'		=> qr/\d+\.\d+ Zambia, Kwacha/,
				'symbol'	=> qr/¤\d+\.\d+/,
				'abbv'		=> qr/\d+\.\d+ ZMK/ },
);

# offset hopefully allows for a large degree fluctuation
my ($start,$final,$offset) = ('10000.00',12500,10000); # mostly given up on getting the offset right
my ($value,$error);

###########################################################

SKIP: {
	skip "Can't see a network connection", 22   if(pingtest($CHECK_DOMAIN));

	my $obj = Finance::Currency::Convert::XE->new();
	isa_ok($obj,'Finance::Currency::Convert::XE','... got the object');

	my @currencies = $obj->currencies;

	is(scalar(@currencies),170,'... correct number of currencies');
	is($currencies[0],  'AED','... valid currency: first');
	is($currencies[47], 'GBP','... valid currency: GBP');
	is($currencies[169],'ZWD','... valid currency: last');

	$value = $obj->convert(
                  'source' => 'GBP',
                  'target' => 'EUR',
                  'value'  => $start,
                  'format' => 'number');

    $error = $obj->error;
    SKIP: {
        skip $error, 3  if(!$value && $error =~ /Unable to retrieve/);

        # have to account for currency fluctuations
        #cmp_ok($value, ">", ($final - $offset),'... conversion above lower limit');
        #cmp_ok($value, "<", ($final + $offset),'... conversion above upper limit');
        like($value,qr/^\d+\.\d+$/,'... conversion matches a number');
    }

	$value = $obj->convert(
                  'source' => 'GBP',
                  'target' => 'EUR',
                  'value'  => $start,
                  'format' => 'text');

    $error = $obj->error;
    SKIP: {
        skip $error, 1  if(!$value && $error =~ /Unable to retrieve/);

    	like($value,qr/\d+\.\d+ Euro/,'... conversion matches a text pattern');
    }

	$value = $obj->convert(
                  'source' => 'GBP',
                  'target' => 'EUR',
                  'value'  => $start);
    $error = $obj->error;
    SKIP: {
        skip $error, 3  if(!$value && $error =~ /Unable to retrieve/);

        # have to account for currency fluctuations
        #cmp_ok($value, ">", ($final - $offset),'... default format conversion above lower limit');
        #cmp_ok($value, "<", ($final + $offset),'... default format conversion above upper limit');
        like($value,qr/^\d+\.\d+$/,'... default format conversion matches a number');
    }

	$value = $obj->convert(
                  'source' => 'GBP',
                  'target' => 'GBP',
                  'value'  => $start);
   	is($value,$start,'... no conversion, should be the same');

	foreach my $curr (keys %format_tests) {
		foreach my $form (keys %{$format_tests{$curr}}) {
			$value = $obj->convert(
						  'source' => $curr,
						  'target' => $curr,
						  'value'  => $start,
						  'format' => $form);
            $error = $obj->error;
            SKIP: {
                skip $error, 1  if(!$value && $error =~ /Unable to retrieve/);

    			like($value,$format_tests{$curr}->{$form},"... format test: $curr/$form");
            }
		}
	}
}

SKIP: {
	skip "Can't see a network connection", 4    if(pingtest($CHECK_DOMAIN));

	my $obj = Finance::Currency::Convert::XE->new(
                  'source' => 'GBP',
                  'target' => 'EUR',
                  'format' => 'bogus');
	isa_ok($obj,'Finance::Currency::Convert::XE','... got the object');

	$value = $obj->convert($start);
    $error = $obj->error;
    SKIP: {
        skip $error, 3  if(!$value && $error =~ /Unable to retrieve/);

        # have to account for currency fluctuations
        #cmp_ok($value, ">", ($final - $offset),'... defaults conversion above lower limit');
        #cmp_ok($value, "<", ($final + $offset),'... defaults conversion above upper limit');
        like($value,qr/^\d+\.\d+$/,'... defaults conversion matches a number');
    }
}

SKIP: {
	skip "Can't see a network connection", 2    if(pingtest($CHECK_DOMAIN));

	my $obj = Finance::Currency::Convert::XE->new(
                  'source' => 'GBP',
                  'target' => 'ARS',
                  'format' => 'number');
	isa_ok($obj,'Finance::Currency::Convert::XE','... got the object');

	$value = $obj->convert($start);
    $error = $obj->error;
    SKIP: {
        skip $error, 1  if(!$value && $error =~ /Unable to retrieve/);

        # Apparently ARS has been causing problems
        like($value,qr/^\d+\.\d+$/,'... defaults conversion matches a number');
    }
}

SKIP: {
	skip "Can't see a network connection", 8    if(pingtest($CHECK_DOMAIN));

	my $obj = Finance::Currency::Convert::XE->new();

    $value = $obj->convert($start);
    is( $value, undef, '... blank source');
    like( $obj->error, qr/Source currency is blank/, '... blank source (error method)');

    $value = $obj->convert(value => $start, source => 'GBP');
    is( $value, undef, '... blank target');
    like( $obj->error, qr/Target currency is blank/, '... blank target (error method)');

    $value = $obj->convert(value => $start, source => 'bogus');
    is( $value, undef, '... bogus source');
    like( $obj->error, qr/is not available/, '... bogus source (error method)');

    $value = $obj->convert(value => $start, source => 'GBP', target => 'bogus');
    is( $value, undef, '... bogus target');
    like( $obj->error, qr/is not available/, '... bogus target (error method)');
}

###########################################################

SKIP: {
	skip "Can't see a network connection", 7    if(pingtest($CHECK_DOMAIN));

	my $obj = Finance::Currency::Convert::XE->new();
	isa_ok($obj,'Finance::Currency::Convert::XE','... got the object');

	my @currencies = $obj->currencies;
	is(scalar(@currencies),170,'... correct number of currencies');

    $obj->add_currencies(
                    ZZZ => {text => 'An Example', symbol => '$'},
                    ZZY => {text => 'Testing'} );
	@currencies = $obj->currencies;
	is(scalar(@currencies),172,'... correct number of currencies');

	is($currencies[170],'ZZY','... valid currency: new penultimate');
	is($currencies[171],'ZZZ','... valid currency: new last');

	my $value = $obj->convert(
			  'source' => 'ZZY',
			  'target' => 'ZZY',
			  'value'  => 5,
			  'format' => 'symbol');
    is($value,'&#164;5.00');

    $value = $obj->convert(
			  'source' => 'ZZY',
			  'target' => 'ZZY',
			  'value'  => 5,
			  'format' => 'text');
    is($value,'5.00 Testing');
}

###########################################################

# crude, but it'll hopefully do ;)
sub pingtest {
    my $domain = shift or return 0;
    my $cmd =   $^O =~ /solaris/i                           ? "ping -s $domain 56 1" :
                $^O =~ /dos|os2|mswin32|netware|cygwin/i    ? "ping -n 1 $domain "
                                                            : "ping -c 1 $domain >/dev/null 2>&1";

    eval { system($cmd) }; 
    if($@) {                # can't find ping, or wrong arguments?
        diag();
        return 1;
    }

    my $retcode = $? >> 8;  # ping returns 1 if unable to connect
    return $retcode;
}