1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
######################################################################
### financequote.pl - KMyMoney interface to Finance::Quote
###
### derived from GnuCash finance-quote-helper script which is
### Copyright 2001 Rob Browning <[email protected]>
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
### published by the Free Software Foundation; either version 2 of
### the License, or (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program# if not, contact:
###
### Free Software Foundation Voice: +1-617-542-5942
### 59 Temple Place - Suite 330 Fax: +1-617-542-2652
### Boston, MA 02111-1307, USA [email protected]
######################################################################
use diagnostics; # while testing
use strict;
use Data::Dumper;
my $prgnam = "kmymoneyfq.pl";
my $version = "1.00";
# perl modules required by this routine and Finance::Quote
my @modules = qw(Date::Manip Finance::Quote LWP XML::Parser XML::Writer);
# main - check command line arguments
my $testonly;
my $listonly;
# analyze the arguments
foreach my $arg (@ARGV) {
my $listopt = "-l"; # I had a much slicker way of doing this but it stopped working...
my $testopt = "-t";
$testonly = 1 if $arg =~ $testopt;
$listonly = 1 if $arg =~ $listopt;
}
# test call; check that all required modules are present
if ($testonly) {
my @absent_modules; # to build list of missing modules
foreach my $module (@modules) {
if (!eval "require $module") {
push (@absent_modules, $module);
}
}
if (@absent_modules) {
foreach my $module (@absent_modules) {
print STDERR " ".$module."\n";
}
exit 254; # missing modules exit code for kmymoney
}
exit 0;
}
# load the required modules
foreach my $module (@modules) {
eval "require $module";
$module->import();
}
# create a finance quote object and set required parameters
my $q = Finance::Quote->new();
$q->set_currency(); # disable any currency conversion
$q->timeout(60); # timeout 60 seconds
$q->failover(0); # disable failover
# process call for exchange list only
if ($listonly) {
my @sources = $q->sources();
foreach my $source (@sources) {
print "$source\n";
}
exit 0;
}
my $source = $ARGV[0];
my $symbol = $ARGV[1];
#print "\tfinding price for <$symbol> from <$source>\n";
my %qhash = $q->fetch($source, $symbol); # get price data from F::Q
#my %qhash = ("RHATsuccess" => 1, "RHATdate" => "4/4/2004", "RHATcurrency" => "USD",
#"RHATbid" => "25.55", "RHATask" => "26.04");
#print Dumper(%qhash);
my $errcode;
$errcode = 0;
if (!%qhash) { $errcode = 1;} # no data from fq (?bad exchange?)
elsif ($qhash {$symbol, "success"} != 1) {$errcode = 2;} # got data but quote failed (?bad symbol?)
elsif (!$qhash{$symbol, "last"}) {$errcode = 3;} # can't find a price (?hmmm?)
if ($errcode != 0) {
print "Error " => "$errcode";
} else {
# extract the date and convert from m/d/yyyy to yyyy-mm-dd
my ($usdate, $month, $day, $year, $yyyymmdd);
$usdate = $qhash{$symbol, "date"};
($month,$day,$year) = ($usdate =~ /([0-9]+)\/([0-9]+)\/([0-9]+)/);
# i'm sure I can do the folowing with a regex but I'm just too idle...
$month = "0$month" if ($month < 9);
$day = "0$day" if ($day < 9);
$yyyymmdd = "$year-$month-$day";
# and the price
# (tried having bid and ask here, but could be undef for some stocks (IBM)
# and looked pretty unrealistic for others (e.g. RHAT on 15/5/04 was 12.09-38.32!))
my $price = $qhash {$symbol, "last"};
print "\"$symbol\",\"$yyyymmdd\",\"$price\"";
}
|
