File Coverage

blib/lib/Finance/Currency/Convert.pm

Criterion	Covered	Total	%
statement	56	106	52.8
branch	5	26	19.2
condition	4	22	18.1
subroutine	11	16	68.7
pod	12	12	100.0
total	88	182	48.3

#!/usr/bin/perl
#
#	Copyright (C) 2000-2025, Jan Willamowius , https://www.willamowius.de/
#	All rights reserved.
#	This is free software; you can redistribute it and/or
#	modify it under the same terms as Perl itself.
#

package Finance::Currency::Convert;

use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '2.12';

my %EuroRates = (
         BEF => {EUR=>0.0247899055505,   BEF => 1},
         DEM => {EUR=>0.511291881196,	 DEM => 1},
         ESP => {EUR=>0.00601012104384,  ESP => 1},
         EUR => {ATS=>13.7603, BEF=>40.3399, DEM=>1.95583, EUR=>1, ESP=>166.386, FIM=>5.94573, FRF=>6.55957, GRD=>340.750, IEP=>.787564, ITL=>1936.27, LUF=>40.3399, NLG=>2.20371, PTE=>200.482, CYP=>0.585274, MTL=>0.429300, SIT=>239.640, SKK=>30.1260, EEK=>15.6466, LTL=>3.45303867403, LVL=>1.42287990894, HRK=>0.132722808415, BGN=>0.511291881196},
         FRF => {EUR=>0.152449017237, 	 FRF => 1},
         GRD => {EUR=>0.00293470286134,  GRD => 1},
         IEP => {EUR=>1.26973807843, 	 IEP => 1},
         ITL => {EUR=>0.000516456899089, ITL => 1},
         LUF => {EUR=>0.0247899055505,   LUF => 1},
         NLG => {EUR=>0.45378021609, 	 NLG => 1},
         ATS => {EUR=>0.0726728341679,   ATS => 1},
         PTE => {EUR=>0.00498797897068,  PTE => 1},
         FIM => {EUR=>0.168187926462,	 FIM => 1},
         CYP => {EUR=>1.70860144137618,  CYP => 1},
         MTL => {EUR=>2.32937339855579,  MTL => 1},
         SIT => {EUR=>0.00417292605575029, SIT => 1},
         SKK => {EUR=>0.0331939188740623,  SKK => 1},
         EEK => {EUR=>0.0639116485371,  EEK => 1},
         LTL => {EUR=>0.2896,           LTL => 1},
         LVL => {EUR=>0.7028,           LVL => 1},
         HRK => {EUR=>7.5345,           HRK => 1},
         BGN => {EUR=>1.95583,          BGN => 1},
		                  );

sub new() {
	my $proto = shift;
	my $ratesFile = shift; # optional
	my $class = ref($proto) || $proto;
	my $self = {};
	$self->{CurrencyRates} = \%EuroRates;
	$self->{RatesFile} = $ratesFile;
	$self->{UserAgent} = "Finance::Currency::Convert $VERSION";
	bless($self, $class);
	$self->readRatesFile() if (defined($ratesFile) && (-e $self->{RatesFile}));
	return $self;
}

sub setRate() {
	my $self = shift;
	my $source = shift;
	my $target = shift;
	my $rate = shift;
	$self->{CurrencyRates}{$source}{$target} = $rate;
}

sub setRatesFile() {
	my $self = shift;
	$self->{RatesFile} = shift;
	$self->readRatesFile() if (-e $self->{RatesFile});
}

sub readRatesFile() {
	my $self = shift;
	if (!defined $self->{RatesFile} || !(-r $self->{RatesFile}) || !((-s $self->{RatesFile}) > 0)) {
		warn("Can't read $self->{RatesFile}\n");
		return;
	}

	open(RATES, "<", $self->{RatesFile}) or ( warn("Can't read $self->{RatesFile}\n") and return );
	while(local $_ = ) {
		my ($source, $targetrates) = split(/\|/, $_);
		foreach my $target (split(/\:/, $targetrates)) {
			my @pieces = split(/\=/, $target);
			if (scalar(@pieces) > 1) {
				$self->setRate($source, $pieces[0], $pieces[1]);
			}
		}
	}
	close(RATES);
}

sub writeRatesFile() {
	my $self = shift;
	return if (!defined $self->{RatesFile});

	open(RATES, ">", $self->{RatesFile}) or ( warn("Can't access $self->{RatesFile}") and return );
	foreach my $sourcerate (sort keys %{$self->{CurrencyRates}}) {
		print RATES "$sourcerate|";
		foreach my $targetrate (sort keys %{ $self->{CurrencyRates}{$sourcerate}}) {
			if (exists($self->{CurrencyRates}{$sourcerate}{$targetrate})
				&& defined($self->{CurrencyRates}{$sourcerate}{$targetrate})
				&& $self->{CurrencyRates}{$sourcerate}{$targetrate} ne '') {
				print RATES "$targetrate=" . $self->{CurrencyRates}{$sourcerate}{$targetrate} . ":";
			}
		}
		print RATES "\n";
	}
	close(RATES);
}

sub _getQuoteFetcher() {
	my $self = shift;
	# test if Finance::Quote is available
	eval { require Finance::Quote; };
	if ($@) {
		warn "Finance::Quote not installed - can't use updateRates()\n";
		return undef;
	};
	# test if Finance::Quote::CurrencyRates::ECB is available
	my $ecbAvailable = 0;
	eval { require Finance::Quote::CurrencyRates::ECB; };
	if ($@) {
		warn "Finance::Quote::CurrencyRates::ECB not installed\n";
	} else {
		$ecbAvailable = 1;
	};
	# get the exchange rates
	my $q;
	if ($ecbAvailable) {
		$q = Finance::Quote->new(currency_rates => {order => ['ECB']});
	} else {
		$q = Finance::Quote->new();
	}
	$q->user_agent->agent($self->{UserAgent});
	return $q;
}

sub updateRates() {
	my $self = shift;
	my @CurrencyList = @_;
	my $q = $self->_getQuoteFetcher();
	return if (!defined($q));
	foreach my $source (@CurrencyList) {
		foreach my $target (sort keys %{ $self->{CurrencyRates}}) {
			$self->setRate($source, $target, $q->currency($source, $target));
		}
	}
	foreach my $source (sort keys %{ $self->{CurrencyRates}}) {
		foreach my $target (@CurrencyList) {
			$self->setRate($source, $target, $q->currency($source, $target));
		}
	}
}

sub updateRate() {
	my $self = shift;
	my $source = shift;
	my $target = shift;
	my $q = $self->_getQuoteFetcher();
	return if (!defined($q));
	# get the exchange rate
	$self->setRate($source, $target, $q->currency($source, $target));
}

sub setUserAgent() {
	my $self = shift;
	$self->{UserAgent} = shift;
}

sub rateAvailable {
	my $self = shift;
	my $source = shift;
	my $target = shift;
	return defined($self->{CurrencyRates}->{$source}{$target});
}

sub convert() {
	my $self = shift;
	my $amount = shift;
	my $source = shift;
	my $target = shift;
	return $amount * $self->{CurrencyRates}->{$source}{$target};
}

sub convertFromEUR() {
	my $self = shift;
	my $amount = shift;
	my $target = shift;
	return $self->convert($amount, "EUR", $target);
}

sub convertToEUR() {
	my $self = shift;
	my $amount = shift;
	my $source = shift;
	return $self->convert($amount, $source, "EUR");
}

1;

__END__