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