File indexing completed on 2024-12-01 04:37:42
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