File indexing completed on 2024-04-28 16:13:27

0001 #!/usr/bin/perl
0002 ######################################################################
0003 ### financequote.pl - KMyMoney interface to Finance::Quote
0004 ###
0005 ### derived from GnuCash finance-quote-helper script which is
0006 ### SPDX-FileCopyrightText: 2001 Rob Browning <rlb@cs.utexas.edu>
0007 ###
0008 ### SPDX-License-Identifier: GPL-2.0-or-later
0009 ######################################################################
0010 
0011 #use diagnostics; # while testing
0012 use strict;
0013 use Data::Dumper;
0014 use POSIX qw(strftime);
0015 
0016 my $prgnam = "financequote.pl";
0017 my $version = "1.1";
0018 # perl modules required by this routine and Finance::Quote
0019 my @modules = qw(Date::Manip Finance::Quote LWP XML::Parser XML::Writer);
0020 
0021 # main - check command line arguments
0022 
0023 my $testonly;
0024 my $listonly;
0025 # analyze the arguments
0026 foreach my $arg (@ARGV) {
0027   my $listopt = "-l"; # I had a much slicker way of doing this but it stopped working...
0028   my $testopt = "-t";
0029   $testonly = 1 if $arg =~ $testopt;
0030   $listonly = 1 if $arg =~ $listopt;
0031 }
0032 
0033 # test call; check that all required modules are present
0034 if ($testonly) {
0035   my @absent_modules; # to build list of missing modules
0036 
0037   foreach my $module (@modules) {
0038     if (!eval "require $module") {
0039       push (@absent_modules, $module);
0040     }
0041   }
0042   if (@absent_modules) {
0043     foreach my $module (@absent_modules) {
0044       print STDERR "  ".$module."\n";
0045     }
0046     exit 254; # missing modules exit code for kmymoney
0047   }
0048   exit 0;
0049 }
0050 
0051 # load the required modules
0052 foreach my $module (@modules) {
0053   eval "require $module";
0054   $module->import();
0055 }
0056 
0057 # create a finance quote object and set required parameters
0058 my $q = Finance::Quote->new();
0059 $q->set_currency();  #  disable any currency conversion
0060 $q->timeout(60);     # timeout 60 seconds
0061 $q->failover(0);     # disable failover
0062 
0063 # process call for exchange list only
0064 if ($listonly) {
0065   my @sources = $q->sources();
0066   foreach my $source (@sources) {
0067     print "$source\n";
0068   }
0069   exit 0;
0070 }
0071 
0072 my $source = $ARGV[0];
0073 my $symbol = $ARGV[1];
0074 
0075 #print "\tfinding price for <$symbol> from <$source>\n";
0076 my  %qhash = $q->fetch($source, $symbol); # get price data from F::Q
0077 #my %qhash = ("RHATsuccess" => 1, "RHATdate" => "4/4/2004", "RHATcurrency" => "USD",
0078                         #"RHATbid" => "25.55", "RHATask" => "26.04");
0079 #print Dumper(%qhash);
0080 my $errcode;
0081 $errcode = 0;
0082 
0083 if (!%qhash) { $errcode = 1;} # no data from fq (?bad exchange?)
0084     elsif ($qhash {$symbol, "success"} != 1) {$errcode = 2;} # got data but quote failed (?bad symbol?)
0085     elsif (!$qhash{$symbol, "last"} and !$qhash{$symbol, "price"} ) {$errcode = 3;} # can't find a price (?hmmm?)
0086 if ($errcode != 0) {
0087     print "Error " => "$errcode";
0088 } else {
0089     # extract the date and convert from m/d/yyyy to yyyy-mm-dd
0090     my ($usdate, $month, $day, $year, $yyyymmdd);
0091     $usdate = $qhash{$symbol, "date"};
0092     if ($usdate != "") {
0093         ($month,$day,$year) = ($usdate =~ /([0-9]+)\/([0-9]+)\/([0-9]+)/);
0094         # i'm sure I can do the following with a regex but I'm just too idle...
0095         $month = "0$month" if ($month < 9);
0096         $day = "0$day" if ($day < 9);
0097         $yyyymmdd = "$year-$month-$day";
0098     } else {
0099         $yyyymmdd = strftime "%Y-%m-%d", localtime
0100     }
0101     # and the price
0102     # (tried having bid and ask here, but could be undef for some stocks (IBM)
0103     # and looked pretty unrealistic for others (e.g. RHAT on 15/5/04 was 12.09-38.32!))
0104     my $price = $qhash {$symbol, "last"};
0105     # if no price was found, try to extract it from the price symbol
0106     # see http://bugs.kde.org/show_bug.cgi?id=234268 for details
0107     $price = $qhash {$symbol, "price"} if (!$price);
0108 
0109     print "\"$symbol\",\"$yyyymmdd\",\"$price\"";
0110 }
0111