anaboe.net

Sourcecode von XRefEUR.pm

package XRefEUR;
 use strict;
 use diagnostics;
 use Carp;
 use LWP::UserAgent;
 use Fcntl qw(O_WRONLY O_RDONLY O_TRUNC O_CREAT LOCK_SH LOCK_EX);
 
 my $version = '1.0 Beta';
 our $ErrorMsg;
 
 sub new {
   my $pkg = shift;
   my $opt = shift;
   croak('XRefEUR: The options must be given as a hash reference.') if ((ref $opt) ne 'HASH');
   foreach my $k (keys %$opt) {
     if( $k ne 'save_dir' && $k ne 'on_the_fly') {
       croak("XRefEUR: unknown option $k or property is read only.");
     }
   }
   my $ref = { save_dir    => $ENV{DOCUMENT_ROOT},
               update_date => time,
               data_source => 'http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml',
               store_file  => '',
               on_the_fly  => 0
             };
   my $obj = bless $ref, $pkg;
   my @date = (localtime($obj->{update_date}))[5,4,3];
   $date[0] += 1900;
   $date[1]++;
   my $date = sprintf("%04d-%02d-%02d", @date);
   $obj->{on_the_fly} = 1 if $opt->{on_the_fly};
   if( exists $opt->{save_dir} ) {
     $obj->{save_dir} = $opt->{save_dir};
   }
   if($obj->{save_dir}) {
     $obj->{save_dir} .= '/' if (rindex $obj->{save_dir}, '/')+1 < (length $obj->{save_dir});
     $obj->{store_file} = $obj->{save_dir}."xref_$date.dat" if !$obj->{on_the_fly};
   }
   else {
     $obj->{store_file} = "xref_$date.dat";
   }
   $obj->{data_source} = $opt->{data_source} if $opt->{data_source};
   return $obj;
 }
 
 sub initializeData {
   my $obj = shift;
   my $response = $obj->_getDataURL;
   if(!$response) {
     return undef;
   }
   if( !$obj->{on_the_fly} && !(-e $obj->{store_file}) ) {
     sysopen SAVE, $obj->{store_file}, O_WRONLY | O_TRUNC | O_CREAT || croak('Fatal error: could not write to ', $obj->{store_file}, ' ($!)');
     print SAVE $response->content;
     close SAVE;
   }
   $obj->{update_date} = $response->date;
   return 1;
 }
 
 sub getAllXRef {
   my $obj = shift;
   return $obj->_getXchangeRate();
 }
 
 sub getSpecXRef {
   my $obj = shift;
   my $cur = shift;
   my $xref = $obj->_getXchangeRate($cur);
   if(!$xref) {
     $ErrorMsg = "No Match found for ".uc($cur)."." if(!$xref);
     return undef;
   }
   else { return $xref->{$cur}; }
 }
 
 sub getXRefDate {
   my $obj = shift;
   my @date = (localtime($obj->{update_date}))[5,4,3];
   $date[0] += 1900; $date[1]++;
   return sprintf("%04d-%02d-%02d", @date);
 }
 
 sub convertToEUR {
   my $obj = shift;
   my $value = shift;
   my $cur = shift;
   my $rate = $obj->getSpecXRef($cur);
   if(!$rate) {
     $ErrorMsg = "No Match found for ".uc($cur).".";
     return 0;
   }
   else {
     return sprintf("%.2f", $value/$rate);
   }
 }
 
 sub convertFromEUR {
   my $obj = shift;
   my $value = shift;
   my $cur = shift;
   my $rate = $obj->getSpecXRef($cur);
   if(!$rate) {
     $ErrorMsg = "No Match found for ".uc($cur).".";
     return 0;
   }
   else {
     return sprintf("%.2f", $value*$rate);
   }
 }
 
 sub _getXchangeRate {
   my $xref = {};
   my $obj = shift;
   my $cur = shift || '[a-z]{3}';
   if($obj->{on_the_fly}) {
     my $res = $obj->_getDataURL(0);
     return undef if(!$res);
     my @erg = ($res->content =~ /<cube currency='($cur)' rate='([0-9.]+)'/gi);
     for(my $i = 0; $i < @erg; $i += 2) {
       $xref->{$erg[$i]} = $erg[$i+1];
     }
   }
   else {
     sysopen DATA, $obj->{store_file}, O_RDONLY or die "XRefEUR: couldn't read data file, error: $!";
     flock DATA, LOCK_SH;
     while(<DATA>) {
       if( $_ =~ /<cube currency='($cur)' rate='([0-9.]+)'/gis ) {
         $xref->{$1} = $2;
         last if $cur ne '[a-z]{3}';
       }
     }
     close DATA;
   }
   if(!$xref) {
     $ErrorMsg = "No Match found for ".uc($cur)."." if(!$xref);
     return undef;
   }
   else { return $xref; }
 }
 
 sub _getDataURL {
   my $obj = shift;
   my $ua = LWP::UserAgent->new;
   $ua->agent('XRefEUR v'.$version.' (http://www.anaboe.net/xrefeur)');
   my $res = $ua->get($obj->{data_source});
   if(!$res->is_success(200)) {
     $ErrorMsg = 'XRefEUR: failed reading '.$obj->{data_source};
     return undef;
   }
   return $res;
 }
 
 1;

Zurück zur Startseite