2020-03-13 14:53:15 -05:00
|
|
|
#!@PERL@ -w
|
2003-01-22 21:54:37 -06:00
|
|
|
#
|
|
|
|
# Copyright (C) 2003, David Hampton <hampton@employees.org>
|
|
|
|
#
|
|
|
|
# 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, write to the Free Software
|
2005-11-16 23:35:02 -06:00
|
|
|
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|
|
|
# 02110-1301, USA.
|
2003-01-22 21:54:37 -06:00
|
|
|
#
|
|
|
|
|
|
|
|
use strict;
|
2003-02-14 13:03:30 -06:00
|
|
|
|
|
|
|
sub check_modules {
|
2015-03-04 08:08:24 -06:00
|
|
|
my @modules = qw(Finance::Quote);
|
2003-02-14 13:03:30 -06:00
|
|
|
my @missing;
|
|
|
|
|
|
|
|
foreach my $mod (@modules) {
|
|
|
|
if (eval "require $mod") {
|
|
|
|
$mod->import();
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
push (@missing, $mod);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return unless @missing;
|
|
|
|
|
|
|
|
print STDERR "$0 cannot find all the Perl modules needed to run.\n";
|
|
|
|
print STDERR "You need to install the following Perl modules:\n";
|
|
|
|
foreach my $mod (@missing) {
|
|
|
|
print STDERR " ".$mod."\n";
|
|
|
|
}
|
2006-06-27 19:02:30 -05:00
|
|
|
print STDERR "Use your system's package manager to install them,\n";
|
|
|
|
print STDERR "or run 'gnc-fq-update' as root.\n";
|
2003-02-14 13:03:30 -06:00
|
|
|
|
|
|
|
exit 1;
|
|
|
|
}
|
2003-01-22 21:54:37 -06:00
|
|
|
|
|
|
|
sub report {
|
2003-11-19 16:11:22 -06:00
|
|
|
my($itemname, $qh, $verbose) = @_;
|
2003-01-22 21:54:37 -06:00
|
|
|
my ($symbol, $date, $currency, $last, $nav, $price, $timezone, $keyname);
|
2016-09-11 18:29:51 -05:00
|
|
|
my($gccanuse, $gcshoulduse) = (1, 1);
|
2005-04-02 13:19:48 -06:00
|
|
|
|
|
|
|
# Sanity check returned results
|
|
|
|
if ((keys %$qh) < 1) {
|
|
|
|
printf("No results found for stock $itemname.\n");
|
|
|
|
return;
|
|
|
|
} else {
|
|
|
|
my ($stock, $attribute, %seen, $first);
|
|
|
|
|
|
|
|
foreach $keyname (sort keys %$qh) {
|
|
|
|
($stock, $attribute) = split('\034', $keyname);
|
|
|
|
last if $stock eq $itemname;
|
|
|
|
$first = $stock if !defined $first;
|
|
|
|
$seen{$stock} = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ($stock ne $itemname) {
|
|
|
|
printf "\nNo results found for stock $itemname, but results were returned for\n";
|
|
|
|
printf "the stock(s) %s. ", join(", ", keys(%seen));
|
|
|
|
printf "Printing data for the first stock returned.\n\n";
|
|
|
|
|
|
|
|
# Print stats for the first stock returned.
|
|
|
|
$itemname = $first;
|
|
|
|
}
|
|
|
|
}
|
2003-01-22 21:54:37 -06:00
|
|
|
|
|
|
|
# Parse the quote fields and put warnings where necessary.
|
2003-11-19 16:11:22 -06:00
|
|
|
if (defined($$qh{$itemname, "symbol"})) {
|
|
|
|
$symbol = $$qh{$itemname, "symbol"};
|
|
|
|
} else {
|
|
|
|
$symbol = "$itemname (deduced)";
|
2005-04-02 13:19:48 -06:00
|
|
|
$gccanuse = 0;
|
2003-11-19 16:11:22 -06:00
|
|
|
}
|
|
|
|
if (defined($$qh{$itemname, "date"})) {
|
|
|
|
$date = $$qh{$itemname, "date"};
|
|
|
|
} else {
|
|
|
|
$date = "** missing **";
|
2016-09-11 18:29:51 -05:00
|
|
|
$gcshoulduse = 0;
|
2003-11-19 16:11:22 -06:00
|
|
|
}
|
|
|
|
if (defined($$qh{$itemname, "currency"})) {
|
|
|
|
$currency = $$qh{$itemname, "currency"};
|
|
|
|
} else {
|
|
|
|
$currency = "** missing **";
|
2005-04-02 13:19:48 -06:00
|
|
|
$gccanuse = 0;
|
2003-11-19 16:11:22 -06:00
|
|
|
}
|
2003-01-22 21:54:37 -06:00
|
|
|
if ((!defined($$qh{$itemname, "last"})) &&
|
|
|
|
(!defined($$qh{$itemname, "nav" })) &&
|
|
|
|
(!defined($$qh{$itemname, "price"}))) {
|
|
|
|
$$qh{$itemname, "last"} = "**missing**";
|
|
|
|
$$qh{$itemname, "nav"} = "**missing**";
|
|
|
|
$$qh{$itemname, "price"} = "**missing**";
|
2005-04-02 13:19:48 -06:00
|
|
|
$gccanuse = 0;
|
2003-01-22 21:54:37 -06:00
|
|
|
}
|
2020-06-09 01:10:25 -05:00
|
|
|
$last = defined($$qh{$itemname, "last"})
|
|
|
|
? $$qh{$itemname, "last"} : "";
|
|
|
|
$nav = defined($$qh{$itemname, "nav"})
|
|
|
|
? $$qh{$itemname, "nav"} : "";
|
|
|
|
$price = defined($$qh{$itemname, "price"})
|
|
|
|
? $$qh{$itemname, "price"} : "";
|
2003-01-22 21:54:37 -06:00
|
|
|
$timezone = defined($$qh{$itemname, "timezone"})
|
|
|
|
? $$qh{$itemname, "timezone"} : "";
|
|
|
|
|
2003-11-19 16:11:22 -06:00
|
|
|
# Dump gnucash recognized fields
|
2003-01-22 21:54:37 -06:00
|
|
|
printf "Finance::Quote fields Gnucash uses:\n";
|
|
|
|
printf " symbol: %-20s <=== required\n", $symbol;
|
2016-09-11 18:29:51 -05:00
|
|
|
printf " date: %-20s <=== recommended\n", $date;
|
2003-01-22 21:54:37 -06:00
|
|
|
printf " currency: %-20s <=== required\n", $currency;
|
|
|
|
printf " last: %-20s <=\\ \n", $last;
|
|
|
|
printf " nav: %-20s <=== one of these\n", $nav;
|
|
|
|
printf " price: %-20s <=/ \n", $price;
|
|
|
|
printf " timezone: %-20s <=== optional\n", $timezone;
|
|
|
|
|
2005-04-02 13:19:48 -06:00
|
|
|
# Report failure
|
|
|
|
if ($gccanuse == 0) {
|
2016-09-11 18:29:51 -05:00
|
|
|
printf "\n** This stock quote cannot be used by GnuCash!\n\n";
|
|
|
|
} elsif ($gcshoulduse == 0) {
|
|
|
|
printf "\n** This quote will have today's date, which might be incorrect.\n";
|
|
|
|
printf " GnuCash will use it, but you might prefer that it doesn't.\n\n";
|
2005-04-02 13:19:48 -06:00
|
|
|
}
|
2003-11-19 16:11:22 -06:00
|
|
|
# Dump all fields if requested
|
|
|
|
if ($verbose) {
|
|
|
|
printf "\nAll fields returned by Finance::Quote for stock $itemname\n\n";
|
|
|
|
printf "%-10s %10s %s\n", "stock", "field", "value";
|
|
|
|
printf "%-10s %10s %s\n", "-----", "-----", "-----";
|
|
|
|
foreach $keyname (sort keys %$qh) {
|
|
|
|
my ($stock, $key) = split('\034', $keyname);
|
|
|
|
printf "%-10s %10s: %s\n", $stock, $key, $$qh{$stock, $key};
|
|
|
|
}
|
|
|
|
print "\n";
|
2003-01-22 21:54:37 -06:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2003-02-14 13:03:30 -06:00
|
|
|
# Check for and load non-standard modules
|
|
|
|
check_modules ();
|
|
|
|
|
2003-01-22 21:54:37 -06:00
|
|
|
my $q = Finance::Quote->new;
|
|
|
|
$q->timeout(60);
|
|
|
|
|
|
|
|
if ($#ARGV < 1) {
|
|
|
|
my @sources = $q->sources();
|
2017-04-28 18:27:55 -05:00
|
|
|
printf "\nUsage: $0 [-v] <quote-source> <stock> [<stock> ...]\n\n";
|
|
|
|
printf "-v: verbose\n";
|
2003-01-22 21:54:37 -06:00
|
|
|
printf "Available sources are: \n %s\n\n", join(' ', @sources);
|
|
|
|
exit 0;
|
|
|
|
}
|
|
|
|
|
2003-11-19 16:11:22 -06:00
|
|
|
my $verbose = 0;
|
2020-03-13 15:22:19 -05:00
|
|
|
if ($ARGV[0] eq "-v") {
|
2003-11-19 16:11:22 -06:00
|
|
|
$verbose = 1;
|
|
|
|
shift;
|
|
|
|
}
|
|
|
|
|
2003-01-22 21:54:37 -06:00
|
|
|
my $exchange = shift;
|
2005-11-16 23:48:38 -06:00
|
|
|
if ($exchange eq "currency") {
|
|
|
|
my $from = shift;
|
|
|
|
while ($#ARGV >= 0) {
|
|
|
|
my $to = shift;
|
|
|
|
my $result = $q->currency($from, $to);
|
2019-01-27 22:44:36 -06:00
|
|
|
# Sometimes quotes are available in only one direction.
|
|
|
|
# If we didn't get the one we wanted try the reverse quote
|
|
|
|
unless (defined($result)) {
|
2015-09-01 16:47:40 -05:00
|
|
|
my $inv_res = $q->currency($to, $from);
|
|
|
|
if (defined($inv_res)) {
|
|
|
|
my $tmp = $to;
|
|
|
|
$to = $from;
|
|
|
|
$from = $tmp;
|
|
|
|
$result = $inv_res;
|
|
|
|
}
|
|
|
|
}
|
2005-11-16 23:58:30 -06:00
|
|
|
if (defined($result)) {
|
|
|
|
printf "1 $from = $result $to\n";
|
|
|
|
} else {
|
|
|
|
printf "1 $from = <unknown> $to\n";
|
|
|
|
}
|
2005-11-16 23:48:38 -06:00
|
|
|
}
|
|
|
|
} else {
|
|
|
|
while ($#ARGV >= 0) {
|
|
|
|
my $stock = shift;
|
|
|
|
my %quotes = $q->fetch($exchange, $stock);
|
|
|
|
report($stock, \%quotes, $verbose);
|
|
|
|
if ($#ARGV >= 0) {
|
|
|
|
printf "=====\n\n";
|
|
|
|
}
|
2003-01-22 21:54:37 -06:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2012-09-24 05:25:33 -05:00
|
|
|
gnc-fq-dump - Print out data from the F::Q module
|
2003-01-22 21:54:37 -06:00
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
2018-01-02 12:43:49 -06:00
|
|
|
gnc-fq-dump alphavantage CSCO JNPR
|
|
|
|
gnc-fq-dump alphavantage BAESY.PK
|
2012-09-24 05:25:33 -05:00
|
|
|
gnc-fq-dump europe 48406.PA 13000.PA
|
|
|
|
gnc-fq-dump vwd 632034
|
|
|
|
gnc-fq-dump ftportfolios FKYGTX
|
2003-01-22 21:54:37 -06:00
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
This program obtains information from Finance::Quote about any
|
|
|
|
specified stock, and then dumps it to the screen in annotated form.
|
|
|
|
This will allow someone to see what is returned, and whether it
|
|
|
|
provides all the information needed by Gnucash.
|
|
|
|
|
|
|
|
=cut
|