[Gnucash-changes] r13303 - gnucash/trunk - Regularize the naming of
the Finance::Quote auxiliary scripts. Remove
David Hampton
hampton at cvs.gnucash.org
Sun Feb 19 17:16:49 EST 2006
Author: hampton
Date: 2006-02-19 17:16:49 -0500 (Sun, 19 Feb 2006)
New Revision: 13303
Trac: http://svn.gnucash.org/trac/changeset/13303
Added:
gnucash/trunk/src/quotes/gnc-fq-check.in
gnucash/trunk/src/quotes/gnc-fq-dump
gnucash/trunk/src/quotes/gnc-fq-helper.in
gnucash/trunk/src/quotes/gnc-fq-update.in
gnucash/trunk/src/quotes/gnc-value-portfolio
Removed:
gnucash/trunk/src/quotes/dump-finance-quote
gnucash/trunk/src/quotes/finance-quote-check.in
gnucash/trunk/src/quotes/finance-quote-helper.in
gnucash/trunk/src/quotes/gnc-prices
gnucash/trunk/src/quotes/update-finance-quote.in
gnucash/trunk/src/quotes/value_portfolio
Modified:
gnucash/trunk/ChangeLog
gnucash/trunk/src/core-utils/gw-core-utils-spec.scm
gnucash/trunk/src/quotes/Makefile.am
gnucash/trunk/src/quotes/README
gnucash/trunk/src/scm/price-quotes.scm
Log:
Regularize the naming of the Finance::Quote auxiliary scripts. Remove
the obsolete gnc-prices script. Move the to the bin directory the
scripts that weren't already there.
Modified: gnucash/trunk/ChangeLog
===================================================================
--- gnucash/trunk/ChangeLog 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/ChangeLog 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,3 +1,19 @@
+2006-02-19 David Hampton <hampton at employees.org>
+
+ * src/quotes/finance-quote-helper.in:
+ * src/quotes/dump-finance-quote:
+ * src/quotes/update-finance-quote.in:
+ * src/quotes/Makefile.am:
+ * src/quotes/value_portfolio:
+ * src/quotes/gnc-prices:
+ * src/quotes/README:
+ * src/quotes/finance-quote-check.in:
+ * src/core-utils/gw-core-utils-spec.scm:
+ * src/scm/price-quotes.scm: Regularize the naming of the
+ Finance::Quote auxiliary scripts. Remove the obsolete gnc-prices
+ script. Move the to the bin directory the scripts that weren't
+ already there.
+
2006-02-19 Joshua Sled <jsled at asynchronous.org>
* src/app-utils/gnc-account-merge.[ch]: Remove placeholder-difference
Modified: gnucash/trunk/src/core-utils/gw-core-utils-spec.scm
===================================================================
--- gnucash/trunk/src/core-utils/gw-core-utils-spec.scm 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/core-utils/gw-core-utils-spec.scm 2006-02-19 22:16:49 UTC (rev 13303)
@@ -44,4 +44,12 @@
'()
"Is debugging mode on?")
+ (gw:wrap-function
+ ws
+ 'g:find-program-in-path
+ '(<gw:mchars> callee-owned const)
+ "g_find_program_in_path"
+ '(((<gw:mchars> caller-owned) program))
+ "Get a boolean value from gconf.")
+
)
Modified: gnucash/trunk/src/quotes/Makefile.am
===================================================================
--- gnucash/trunk/src/quotes/Makefile.am 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/Makefile.am 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,23 +1,18 @@
+bin_SCRIPTS = gnc-fq-check gnc-fq-dump gnc-fq-helper gnc-fq-update
-gncsharedir = ${GNC_SHAREDIR}
-
-bin_SCRIPTS = dump-finance-quote gnc-prices update-finance-quote
-gncshare_SCRIPTS = finance-quote-helper finance-quote-check
-
EXTRA_DIST = \
Quote_example.pl \
- finance-quote-check.in \
- finance-quote-helper.in \
- gnc-prices \
- update-finance-quote.in \
- value_portfolio \
- dump-finance-quote
+ gnc-fq-check.in \
+ gnc-fq-dump \
+ gnc-fq-helper.in \
+ gnc-fq-update.in \
+ gnc-value-portfolio
## We borrow guile's convention and use @-...-@ as the substitution
## brackets here, instead of the usual @... at . This prevents autoconf
## from substituting the values directly into the left-hand sides of
## the sed substitutions.
-finance-quote-helper: finance-quote-helper.in Makefile
+gnc-fq-helper: gnc-fq-helper.in Makefile
rm -f $@.tmp
sed < $< > $@.tmp \
-e 's:@-PERL-@:${PERL}:g' \
@@ -25,7 +20,7 @@
chmod +x $@.tmp
mv $@.tmp $@
-finance-quote-check: finance-quote-check.in Makefile
+gnc-fq-check: gnc-fq-check.in Makefile
rm -f $@.tmp
sed < $< > $@.tmp \
-e 's:@-PERL-@:${PERL}:g' \
@@ -33,7 +28,7 @@
chmod +x $@.tmp
mv $@.tmp $@
-update-finance-quote: update-finance-quote.in Makefile
+gnc-fq-update: gnc-fq-update.in Makefile
rm -f $@.tmp
sed < $< > $@.tmp \
-e 's:@-PERL-@:${PERL}:g' \
@@ -41,4 +36,4 @@
chmod +x $@.tmp
mv $@.tmp $@
-CLEANFILES = finance-quote-helper finance-quote-check update-finance-quote
+CLEANFILES = gnc-fq-helper gnc-fq-check gnc-fq-update
Modified: gnucash/trunk/src/quotes/README
===================================================================
--- gnucash/trunk/src/quotes/README 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/README 2006-02-19 22:16:49 UTC (rev 13303)
@@ -2,18 +2,30 @@
This directory contains assorted stock quote scripts.
-finance-quote-helper.in:
+gnc-fq-check.in:
- Source file for finance-quote-helper which is a perl script that
+ Source file for gnc-fq-check which is a perl script that allows
+ gnucash to determine if Finance::Quote is installed properly. The
+ responses is a scheme form.
+
+gnc-fq-dump:
+
+ A perl script that retrieves a quote from Finance::Quote and dumps
+ the response to the terminal. Its useful for determining problems
+ with F::Q.
+
+gnc-fq-helper.in:
+
+ Source file for gnc-fq-helper which is a perl script that
allows gnucash to communicate with Finance::Quote over pipes from
guile. The requests and responses are scheme forms.
-gnc-prices:
+gnc-fq-update.in:
- Deprecated wrapper to support old setup. Use "gnucash --add-quotes
- filename" instead.
+ Source file for gnc-fq-update which is a perl script that updates
+ Finance::Quote from CPAN.
-value_portfolio:
+gnc-value-portfolio:
A stand-alone perl script for updating and printing the value of a
portfolio. To use this script, edit the the first few lines at the
Deleted: gnucash/trunk/src/quotes/dump-finance-quote
===================================================================
--- gnucash/trunk/src/quotes/dump-finance-quote 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/dump-finance-quote 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,204 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2003, David Hampton <hampton at 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
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301, USA.
-#
-
-use strict;
-
-sub check_modules {
- my @modules = qw(Date::Manip Finance::Quote LWP HTML::TableExtract);
- 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";
- }
- print STDERR "Run 'update-finance-quote' as root to install them.\n";
-
- exit 1;
-}
-
-sub report {
- my($itemname, $qh, $verbose) = @_;
- my ($symbol, $date, $currency, $last, $nav, $price, $timezone, $keyname);
- my($gccanuse);
-
- # 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;
- }
- }
-
- # Parse the quote fields and put warnings where necessary.
- $gccanuse = 1;
- if (defined($$qh{$itemname, "symbol"})) {
- $symbol = $$qh{$itemname, "symbol"};
- } else {
- $symbol = "$itemname (deduced)";
- $gccanuse = 0;
- }
- if (defined($$qh{$itemname, "date"})) {
- $date = $$qh{$itemname, "date"};
- } else {
- $date = "** missing **";
- $gccanuse = 0;
- }
- if (defined($$qh{$itemname, "currency"})) {
- $currency = $$qh{$itemname, "currency"};
- } else {
- $currency = "** missing **";
- $gccanuse = 0;
- }
- 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**";
- $gccanuse = 0;
- } else {
- $last = defined($$qh{$itemname, "last"})
- ? $$qh{$itemname, "last"} : "";
- $nav = defined($$qh{$itemname, "nav"})
- ? $$qh{$itemname, "nav"} : "";
- $price = defined($$qh{$itemname, "price"})
- ? $$qh{$itemname, "price"} : "";
- }
- $timezone = defined($$qh{$itemname, "timezone"})
- ? $$qh{$itemname, "timezone"} : "";
-
- # Dump gnucash recognized fields
- printf "Finance::Quote fields Gnucash uses:\n";
- printf " symbol: %-20s <=== required\n", $symbol;
- printf " date: %-20s <=== required\n", $date;
- 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;
-
- # Report failure
- if ($gccanuse == 0) {
- printf "\n** This stock quote cannot be used by gnucash!!\n\n";
- }
-
- # 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";
- }
-}
-
-# Check for and load non-standard modules
-check_modules ();
-
-my $q = Finance::Quote->new;
-$q->timeout(60);
-
-if ($#ARGV < 1) {
- my @sources = $q->sources();
- printf "\nUsage: $0 <quote-source> [-v] <stock> [<stock> ...]\n\n";
- printf "Available sources are: \n %s\n\n", join(' ', @sources);
- exit 0;
-}
-
-my $verbose = 0;
-if (@ARGV[0] eq "-v") {
- $verbose = 1;
- shift;
-}
-
-my $exchange = shift;
-if ($exchange eq "currency") {
- my $from = shift;
- while ($#ARGV >= 0) {
- my $to = shift;
- my $result = $q->currency($from, $to);
- if (defined($result)) {
- printf "1 $from = $result $to\n";
- } else {
- printf "1 $from = <unknown> $to\n";
- }
- }
-} else {
- while ($#ARGV >= 0) {
- my $stock = shift;
- my %quotes = $q->fetch($exchange, $stock);
- report($stock, \%quotes, $verbose);
- if ($#ARGV >= 0) {
- printf "=====\n\n";
- }
- }
-}
-
-=head1 NAME
-
-dump-finance-quote - Print out data from the F::Q module
-
-=head1 SYNOPSIS
-
- dump-finance-quote yahoo CSCO JNPR
- dump-finance-quote yahoo BAESY.PK
- dump-finance-quote europe 48406.PA 13000.PA
- dump-finance-quote vwd 632034
- dump-finance-quote ftportfolios FKYGTX
-
-=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
Deleted: gnucash/trunk/src/quotes/finance-quote-check.in
===================================================================
--- gnucash/trunk/src/quotes/finance-quote-check.in 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/finance-quote-check.in 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,91 +0,0 @@
-#!@-PERL-@ -w
-######################################################################
-### finance-quote-check - check for the presence of Finance::Quote
-### From finance-quote-helper.
-### Copyright 2001 Rob Browning <rlb at cs.utexas.edu>
-###
-### 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
-### 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-### Boston, MA 02110-1301, USA gnu at gnu.org
-######################################################################
-
-use lib '@-PERLINCL-@';
-
-use strict;
-use English;
-use FileHandle;
-
-# Input: <none>
-#
-# Output (on standard output, one output form per input line):
-#
-# A list of quote sources supported by Finance::Quote, or the single
-# term missing-lib if finance quote could not be executed.
-#
-# Exit status
-#
-# 0 - success
-# non-zero - failure
-
-sub check_modules {
- my @modules = qw(Date::Manip Finance::Quote LWP HTML::Parser HTML::TableExtract);
- my @missing;
-
- foreach my $mod (@modules) {
- if (eval "require $mod") {
- $mod->import();
- }
- else {
- push (@missing, $mod);
- }
- }
-
- return unless @missing;
-
- print STDERR "\n";
- print STDERR "You need to install the following Perl modules:\n";
- foreach my $mod (@missing) {
- print STDERR " ".$mod."\n";
- }
-
- print STDERR "\n";
- print STDERR "Run 'update-finance-quote' as root to install them.\n";
-
- print "missing-lib\n";
-
- exit 1;
-}
-
-#---------------------------------------------------------------------------
-# Runtime.
-
-# Check for and load non-standard modules
-check_modules ();
-
-# Create a stockquote object.
-my $quoter = Finance::Quote->new();
-my $prgnam = "scmio-finance-quote";
-
-my @qsources;
-my @sources = $quoter->sources();
-foreach my $source (@sources) {
- push(@qsources, "\"$source\"");
-}
-printf "(%s %s)\n", $Finance::Quote::VERSION, join(" ", qq/@qsources/);
-
-## Local Variables:
-## mode: perl
-## End:
Deleted: gnucash/trunk/src/quotes/finance-quote-helper.in
===================================================================
--- gnucash/trunk/src/quotes/finance-quote-helper.in 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/finance-quote-helper.in 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,419 +0,0 @@
-#!@-PERL-@ -w
-######################################################################
-### finance-quote-helper - present a scheme interface to Finance::Quote
-### Copyright 2001 Rob Browning <rlb at cs.utexas.edu>
-###
-### 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
-### 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-### Boston, MA 02110-1301, USA gnu at gnu.org
-######################################################################
-
-use lib '@-PERLINCL-@';
-
-use strict;
-use English;
-use FileHandle;
-
-# Input: (on standard input - one entry per line and one line per
-# entry, and double quotes must only be delimiters, not string
-# content -- remember, we don't have a real scheme parser on the perl
-# side :>).
-
-# (<method-name> symbol symbol symbol ...)
-
-# where <method-name> indicates the desired Finance::Quote method.
-# The currently recognized subset is yahoo, yahoo_europe,
-# fidelity_direct, troweprice_direct, vanguard, asx, tiaacref,
-# and currency.
-
-# For currency quotes, the symbols alternate between the 'from'
-# and 'to' currencies.
-
-# For examle:
-#
-# (yahoo "IBM" "LNUX")
-# (fidelity_direct "FBIOX" "FSELX")
-# (currency "USD" "AUD")
-
-# Output (on standard output, one output form per input line):
-
-# Schemified version of finance-quote's output, basically an alist of
-# alists, as in the example below. Right now, only the fields that
-# this script knows about (and knows how to convert to scheme) are
-# returned, so the conversion function will have to be updated
-# whenever Finance::Quote changes. Currently you'll get symbol,
-# gnc:time-no-zone, and currency, and either last, nav, or price.
-# Fields with gnc: prefixes are non-Finance::Quote fields.
-# gnc:time-no-zone is returned as a string of the form "YYYY-MM-DD
-# HH:MM:SS", basically the unmolested (and underspecified) output of
-# the quote source. It's up to you to know what it's proper timezone
-# really is. i.e. if you know the time was in America/Chicago, you'll
-# need to convert it to that.
-
-# For example:
-
-# $ echo '(yahoo "CSCO" "JDSU" "^IXIC")' | ./finance-quote-helper
-# (("CSCO" (symbol . "CSCO")
-# (gnc:time-no-zone . "2001-03-13 19:27:00")
-# (last . 20.375)
-# (currency . "USD"))
-# ("JDSU" (symbol . "JDSU")
-# (gnc:time-no-zone . "2001-03-13 19:27:00")
-# (last . 23.5625)
-# (currency . "USD"))
-# ("^IXIC" (symbol . ^IXIC)
-# (gnc:time-no-zone . 2002-12-04 17:16:00)
-# (last . 1430.35)
-# (currency . failed-conversion)))
-
-# On error, the overall result may be #f, or on individual errors, the
-# list sub-item for a given symbol may be #f, like this:
-
-# $ echo '(yahoo "CSCO" "JDSU")' | ./finance-quote-helper
-# (#f
-# ("JDSU" (symbol . "JDSU")
-# (gnc:time-no-zone . "2001-03-13 19:27:00")
-# (last . 23.5625)
-# (currency . "USD")))
-
-# further, errors may be stored with each quote as indicated in
-# Finance::Quote, and whenever the conversion to scheme data fails,
-# the field will have the value 'failed-conversion, and accordingly
-# this symbol will never be a legitimate conversion.
-
-# Exit status
-#
-# 0 - success
-# non-zero - failure
-
-# The methods we know about. For now we assume they all have the same
-# signature so this works OK.
-
-sub check_modules {
- my @modules = qw(Date::Manip Finance::Quote LWP HTML::TableExtract);
- my @missing;
-
- foreach my $mod (@modules) {
- if (eval "require $mod") {
- $mod->import();
- }
- else {
- push (@missing, $mod);
- }
- }
-
- return unless @missing;
-
- print STDERR "\n";
- print STDERR "You need to install the following Perl modules:\n";
- foreach my $mod (@missing) {
- print STDERR " ".$mod."\n";
- }
-
- print STDERR "\n";
- print STDERR "Run 'update-finance-quote' as root to install them.\n";
-
- print "missing-lib";
-
- exit 1;
-}
-
-sub schemify_string {
- my($str) = @_;
-
- if(!$str) { return "failed-conversion"; }
-
- # FIXME: Is this safe? Can we just double all backslashes and backslash
- # escape all double quotes and get the right answer?
-
- # double all backslashes.
- my $bs = "\\";
- $str =~ s/$bs$bs/$bs$bs/gmo;
-
- # escape all double quotes.
- # Have to do this because the perl-mode parser freaks out otherwise.
- my $dq = '"';
- $str =~ s/$dq/$bs$dq/gmo;
- return '"' . $str . '"';
-}
-
-sub schemify_boolean {
- my($bool) = @_;
-
- if($bool) {
- return "#t";
- } else {
- return "#f";
- }
-}
-
-sub schemify_num {
- my($numstr) = @_;
- # This is for normal numbers, not the funny ones like "2.346B".
- # For now we don't need to do anything.
-
- if(!$numstr) { return "failed-conversion"; }
-
- if($numstr =~ /^\s*(\d+(\.\d+)?)$/o) {
- return $1;
- } else {
- return "failed-conversion";
- }
-}
-
-sub schemify_date {
- # return the date in epoch seconds.
- my ($datestr) = @_;
-
- my $date = ParseDate($datestr);
- my $result = UnixDate($date, "%s");
- if($result !~ /^(\+|-)?\d+$/) {
- $result = "failed-conversion";
- }
- return("$result");
-}
-
-# sub schemify_range {
-# #convert range in form ``num1 - num2'' to ``(num1 num2)''.
-# }
-
-sub get_quote_time {
- # return the date.
- my ($item, $quotehash) = @_;
-
- my $datestr = $$quotehash{$item, 'date'};
- my $timestr = $$quotehash{$item, 'time'};
-
- if(!$datestr) {
- return undef;
- }
-
- my $parsestr = $datestr;
- if($timestr) {
- $parsestr .= " $timestr";
- }
-
- $parsestr = ParseDateString($parsestr);
-
- my $result = UnixDate($parsestr, "\"%Y-%m-%d %H:%M:%S\"");
- if($result !~ /^\"\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d\"$/) {
- $result = "failed-conversion";
- }
- return $result;
-}
-
-sub schemify_quote {
- my($itemname, $quotehash, $indentlevel) = @_;
- my $scmname = schemify_string($itemname);
- my $quotedata = "";
- my $field;
- my $data;
-
- if (!$$quotehash{$itemname, "success"}) {
- return schemify_boolean(0);
- }
-
- $field = 'symbol';
- if (($$quotehash{$itemname, $field})) {
- $data = schemify_string($$quotehash{$itemname, $field});
- } else {
- # VWD and a few others don't set the symbol field
- $data = schemify_string($itemname);
- }
- $quotedata .= "($field . $data)";
-
- $field = 'gnc:time-no-zone';
- $data = get_quote_time($itemname, $quotehash);
- $quotedata .= " ($field . $data)" if $data;
-
- $field = 'last';
- if (!($$quotehash{$itemname, $field})) {
- $field = 'nav';
- }
- if (!($$quotehash{$itemname, $field})) {
- $field = 'price';
- }
-
- $data = schemify_num($$quotehash{$itemname, $field});
- $quotedata .= " ($field . $data)";
-
- $field = 'currency';
- $data = schemify_string($$quotehash{$itemname, $field});
- $quotedata .= " ($field . $data)";
-
- return "($scmname $quotedata)";
-}
-
-sub schemify_quotes {
- my($symbols, $quotehash) = @_;
- my $resultstr = "";
- my $sym;
- my $separator = "";
-
- # we have to pass in @$items because Finance::Quote just uses the
- # mangled "$name$field string as the key, so there's no way (I know
- # of) to find out which stocks are in a given quotehash, just given
- # the quotehash.
-
- foreach $sym (@$symbols) {
- $resultstr .= $separator . schemify_quote($sym, $quotehash, 2);
- if(!$separator) { $separator = "\n "; }
- }
- return "($resultstr)\n";
-}
-
-sub parse_input_line {
-
- # FIXME: we need to rewrite parsing to handle commands modularly.
- # Right now all we do is hard-code "fetch".
-
- my($input) = @_;
- # Have to do this because the perl-mode parser freaks out otherwise.
- my $dq = '"';
- my @symbols;
-
- # Make sure we have an opening ( preceeded only by whitespace.
- # and followed by a one word method name composed of [a-z_]+.
- # Also allow the '.' and '^' characters for stock indices.
- # Kill off the whitespace if we do and grab the command.
- if($input !~ s/^\s*\(\s*([\.\^a-z_]+)\s+//o) { return 0; }
-
- my $quote_method_name = $1;
-
- # Make sure we have an ending ) followed only by whitespace
- # and kill it off if we do...
- if($input !~ s/\s*\)\s*$//o) { return 0; }
-
- while($input) {
- # Items should look like "RHAT"
- # Grab RHAT and delete "RHAT"\s*
- if($input !~ s/^$dq([^$dq]+)$dq\s*//o) { return 0; }
- my $symbol = $1;
- push @symbols, $symbol;
- }
-
- my @result = ($quote_method_name, \@symbols);
- return \@result;
-}
-
-#---------------------------------------------------------------------------
-# Runtime.
-
-# Check for and load non-standard modules
-check_modules ();
-
-# Create a stockquote object.
-my $quoter = Finance::Quote->new();
-my $prgnam = "scmio-finance-quote";
-
-# Disable default currency conversions.
-$quoter->set_currency();
-
-while(<>) {
-
- my $result = parse_input_line($_);
-
- if(!$result) {
- print STDERR "$prgnam: bad input line ($_)\n";
- exit 1;
- }
-
- my($quote_method_name, $symbols) = @$result;
- my %quote_data;
-
- if($quote_method_name =~ m/^currency$/) {
- my ($from_currency, $to_currency) = @$symbols;
-
- last unless $from_currency;
- last unless $to_currency;
-
- my $price = $quoter->currency($from_currency, $to_currency);
- last unless $price;
-
- $quote_data{$from_currency, "success"} = 1;
- $quote_data{$from_currency, "symbol"} = $from_currency;
- $quote_data{$from_currency, "currency"} = $to_currency;
- $quote_data{$from_currency, "last"} = $price;
-
- my @new_symbols = ($from_currency);
- $symbols = \@new_symbols;
- } else {
- %quote_data = $quoter->fetch($quote_method_name, @$symbols);
- }
-
- if(!%quote_data) {
- print "#f\n";
- exit 1;
- }
-
- print schemify_quotes($symbols, \%quote_data);
- STDOUT->flush();
-}
-
-exit 0;
-
-__END__
-
-# Keep this around in case we need to go back to complex per-symbol args.
-#
-# while($input) {
-# # Items should look like "RHAT" "EST")
-# # Grab RHAT and delete ("RHAT"\s*
-# if($input !~ s/^\(\s*$dq([^$dq]+)$dq\s*//o) { return 0; }
-# my $symbol = $1;
-# my $timezone;
-# # Now grab EST or #f and delete \s*"EST") or #f)
-# if($input =~ s/^\s*$dq([^$dq]+)$dq\)\s*//o) {
-# $timezone = $1;
-# } else {
-# if($input =~ s/^\s*(\#f)\)\s*//o) {
-# $timezone = 0;
-# } else {
-# return 0;
-# }
-# }
-
-# sub get_quote_utc {
-# # return the date in utc epoch seconds, using $timezone if specified.
-# my ($item, $timezone, $quotehash) = @_;
-
-# if(!defined($timezone)) { return "failed-conversion"; }
-
-# my $datestr = $$quotehash{$item, 'date'};
-# my $timestr = $$quotehash{$item, 'time'};
-
-# if(!$datestr) {
-# return "failed-conversion";
-# }
-# my $parsestr = $datestr;
-# if($timestr) {
-# $parsestr .= " $timestr";
-# }
-
-# if($timezone) {
-# # Perform a conversion.
-# $parsestr = Date_ConvTZ(ParseDate($parsestr), $timezone, 'UTC');
-# }
-# my $result = UnixDate($parsestr, "%s");
-# if($result !~ /^(\+|-)?\d+$/) {
-# $result = "failed-conversion";
-# }
-# return $result;
-# }
-
-## Local Variables:
-## mode: perl
-## End:
Copied: gnucash/trunk/src/quotes/gnc-fq-check.in (from rev 13293, gnucash/trunk/src/quotes/finance-quote-check.in)
Copied: gnucash/trunk/src/quotes/gnc-fq-dump (from rev 13293, gnucash/trunk/src/quotes/dump-finance-quote)
Copied: gnucash/trunk/src/quotes/gnc-fq-helper.in (from rev 13293, gnucash/trunk/src/quotes/finance-quote-helper.in)
Copied: gnucash/trunk/src/quotes/gnc-fq-update.in (from rev 13293, gnucash/trunk/src/quotes/update-finance-quote.in)
Deleted: gnucash/trunk/src/quotes/gnc-prices
===================================================================
--- gnucash/trunk/src/quotes/gnc-prices 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/gnc-prices 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,23 +0,0 @@
-#!/bin/sh
-#
-# Usage: gnc-prices <datafile>
-
-# Vestigal script for adding current prices to a gnucash data file for
-# all the accounts having a price source.
-
-if [ "$#" -ne 1 ]
-then
- echo "Usage: gnc-prices <file>"
- exit 1
-fi
-
-echo -n "gnc-prices is obsolete: "
-
-if [ "$1"x = x ]
-then
- echo "please use gnucash --add-price-quotes <file>"
-else
- echo "please use gnucash --add-price-quotes $1"
-fi
-
-exec gnucash --add-price-quotes "$1"
Copied: gnucash/trunk/src/quotes/gnc-value-portfolio (from rev 13293, gnucash/trunk/src/quotes/value_portfolio)
Deleted: gnucash/trunk/src/quotes/update-finance-quote.in
===================================================================
--- gnucash/trunk/src/quotes/update-finance-quote.in 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/update-finance-quote.in 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,49 +0,0 @@
-#!@-PERL-@ -w
-######################################################################
-### update-finance-quote - present a scheme interface to Finance::Quote
-### Copyright 2001 Gnumatic, Inc.
-###
-### 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
-### 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-### Boston, MA 02110-1301, USA gnu at gnu.org
-######################################################################
-
-use lib '@-PERLINCL-@';
-
-use strict;
-use CPAN;
-
-if ($( != 0) {
- print "\n";
- print "You probably need to be root before running update-finance-quote.";
- print "\n\n";
- print "Do you want to continue? (y/n) ";
-
- my $input = <STDIN>;
- chomp ($input);
-
- exit 0 if ($input ne "y");
-}
-
-CPAN::Shell->install('LWP');
-CPAN::Shell->install('Date::Manip');
-CPAN::Shell->install('HTML::Parser');
-CPAN::Shell->install('HTML::TableExtract');
-CPAN::Shell->install('Finance::Quote');
-
-## Local Variables:
-## mode: perl
-## End:
Deleted: gnucash/trunk/src/quotes/value_portfolio
===================================================================
--- gnucash/trunk/src/quotes/value_portfolio 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/quotes/value_portfolio 2006-02-19 22:16:49 UTC (rev 13303)
@@ -1,672 +0,0 @@
-#!/usr/bin/perl -w
-#######################################################################
-# $Id$
-# Looks up investment prices on the web, and builds a report
-# to summarize the results
-#######################################################################
-$HISTORYFILE="histprices";
-$newprices = "NO"; # Haven't found *any* new prices so far...
-
-#######################################################################
-# Start by initializing the security list
-#######################################################################
-# My TSE stocks...
-
-#######################################################################
-&add_stock("T", 100, 1670.5, "TSE");
-#&add_stock("NVA", 100, 1345.5, "TSE");
-&add_stock("NVA", 100, -10.16, "TSE");
-&add_stock("TRP", 52, 1345.50, "TSE");
-&add_stock("PCA", 100, 1733, "TSE");
-&add_stock("TOC", 50, 21.035*50, "TSE");
-&add_stock("RY", 50, 32.785*50, "TSE");
-
-#######################################################################
-# My Canada Trust Everest funds...
-#######################################################################
-# Original numbers of units...
-#&add_stock("CTMM", 83.951, 839.51, "CTE"); # Not strictly correct..
-#&add_stock("CTBOND", 121.747, 1315.17, "CTE");
-#&add_stock("CTSTK", 57.177, 832.73, "CTE");
-#&add_stock("CTSPEC", 28.263, 504.07, "CTE");
-#&add_stock("CTAMER", 177.723, 1983.05, "CTE");
-#&add_stock("CTUSEQ", 19.644, 294.91, "CTE");
-#&add_stock("CTASIA", 28.224, 251.99, "CTE");
-#&add_stock("CTEURO", 60.136, 530.50, "CTE");
-#&add_stock("CTEMER", 27.463, 266.67, "CTE");
-#&add_stock("CTIBND", 84.879, 907.37, "CTE");
-
-# Units as at Oct 31/98
-&add_stock("CTMM", 89.572, 839.51, "CTE");
-
-&add_stock("CTBOND", 137.398, 1315.17, "CTE");
-&add_stock("CTSTK", 62.896, 832.73, "CTE");
-&add_stock("CTSPEC", 28.263, 504.07, "CTE");
-&add_stock("CTAMER", 251.604, 1983.05, "CTE");
-&add_stock("CTUSEQ", 20.467, 294.91, "CTE");
-&add_stock("CTASIA", 28.238, 251.99, "CTE");
-&add_stock("CTEURO", 91.298, 530.50, "CTE");
-&add_stock("CTEMER", 27.463, 266.67, "CTE");
-&add_stock("CTIBND", 94.264, 907.37, "CTE");
-
-# Stuff on NYSE
-&add_stock("MOT", 15, (62+5/8)*15, "NYSE");
-#&add_stock("IFMXE", 0.1, 0.1, "NYSE");
-&add_stock("TSG", 13.0289, 43.02*5+43.75+44.48, "NYSE");
-&add_stock("TSG", 27.619-13.0289, 44.48*8, "NYSE");
-
-# SuperSaver 401(k)... Approximate...
-&add_stock("AADBX", 0.3*2115.93/14, 0.3*1604.85, "NYSE");
-&add_stock("AADEX", 0.5*2115.93/19, 0.5*1604.85, "NYSE");
-&add_stock("AAIEX", 0.2*2115.93/15, 0.2*1604.85, "NYSE");
-
-# SGRP Balances: Approximate...
-&add_stock("AADBX", 712.33/14.9, 700, "NYSE"); # Balanced
-&add_stock("AADEX", 4556.64/22.5 + (533.94+200.24+183.55)/22.5, 3500+(533.94+200.24+183.55), "NYSE"); # Equity
-&add_stock("AAIEX", 1829.63/18.8 + (213.57+80.1+73.41)/18.8, 1700+(213.57+80.1+73.41), "NYSE"); # Int'l Equity
-&add_stock("AASPX", 2104.81/15 + (320.37+120.12+110.13)/15, 1900 + (320.37+120.12+110.13), "NYSE"); # Stock Index
-
-
-#######################################################################
-# Working Ventures fund...
-#######################################################################
-&add_stock("WORKVE", 219.701, 3000, "OTHER");
-$PRICE{"WORKVE"} = 3000/219.701; # Hack in a price for Working Ventures
-$OLD{"WORKVE"} = "yes"; # Indicate that this is *not* a "new" price...
-
-
-#######################################################################
-# Map CT Everest fund names to the "short" IDs
-#######################################################################
-# I don't want to get long names; this builds an array that
-# shortens the names used in the CT Everest Funds web page to
-# the ones used above
-#######################################################################
-&ct_fund_ids; # Get mapping of CT "long" fund names to "short" names
-
-&load_prices; # Load old prices, so that failure to get a price
- # means we fall back to the previously-found
- # price
-
-$CURRNAME{"CDN"} = "Canadian";
-$CURRNAME{"USD"} = "United States";
-$CURRATE{"CDN"} = 1;
-$CURRATE{"USD"} = 1.37;
-&get_currency("USD");
-#######################################################################
-# Now, get the current prices by sundry queries of web sites
-#######################################################################
-&search_web_for_prices(); # Find new closing prices
-&calc_variances(); # Calculate variances
-
-#######################################################################
-# Run report that details portfolio value based on the prices, costs
-# and quantities of shares...
-#######################################################################
-if ($newprices eq "YES") {
- &show_report(); # Display a report summarizing the results...
-# &show_variances();
-# &hilo_portfolios();
- &save_prices(); # Save prices...
-}
-exit 0; # Done
-
-#######################################################################
-#######################################################################
-#######################################################################
-#######################################################################
-#######################################################################
-######################## End of the main body #########################
-#######################################################################
-#######################################################################
-#######################################################################
-#######################################################################
-#######################################################################
-
-#######################################################################
-#######################################################################
-############################# Subroutines #############################
-#######################################################################
-#######################################################################
-
-
-#######################################################################
-############### &add_stock("NVA", 100, 1345.5, "TSE"); ################
-#######################################################################
-# Add a security to the "active list," including the "ticker symbol,"
-# quantity of shares, original total cost, and the exchange to look it
-# up on.
-#######################################################################
-sub add_stock {
- local($ticker, $num, $cost, $exchange) = @_;
- $NUM{$ticker} += $num;
- $COST{$ticker} += $cost;
- $EXCHANGE{$ticker} = $exchange;
- local ($currency) = "CDN";
- if ($exchange eq "TSE") {
- $currency = "CDN";
- }
- if ($exchange eq "NYSE") {
- $currency = "USD";
- }
- if ($exchange eq "NY") {
- $currency = "USD";
- }
- $CURRENCY{$ticker} = $currency;
-}
-
-#######################################################################
-######## &get_url_command("http://www.conline.com/~cbbrowne");#########
-#######################################################################
-# Build the appropriate command that accesses (in raw form) the
-# requested URL. Probably ought to change this to use the w3c
-# "line mode" utility, as it's minscule
-#######################################################################
-sub get_url_command {
- local ($url) = @_;
- return "lynx -source '$url'";
-}
-
-#######################################################################
-###################### &search_web_for_prices(); ######################
-#######################################################################
-# This program searches the %EXCHANGE array, determining how
-# the security price should be searched out, and invokes the
-# appropriate method.
-#######################################################################
-sub search_web_for_prices {
- local ($ticker);
-
- # Do some per-ticker searching
- foreach $ticker (keys EXCHANGE) {
- local($exchange) = $EXCHANGE{$ticker};
- if ($exchange eq "TSE") {
- &get_TSE($ticker);
- &get_yahoo($ticker, "TSE");
- }
-
- if ($exchange eq "CTE") {
- # Do nothing; data is coming
- # in en masse via &get_all_everest_rates;
- }
- if ($exchange eq "NYSE") {
- &get_yahoo($ticker, $EXCHANGE{$ticker});
- }
- }
-
- # search for CT Everest fund data
- &get_CT_Everest; # Get Everest mutual fund data
-
- # Search for Working Ventures fund data
- &get_WV;
-
- # get all of the TSE stock prices
- # foreach $ticker (ord("a")..ord("z")) {
- # &get_TSE( chr($ticker) );
- # }
-}
-
-#######################################################################
-########################## &get_TSE ("RY"); ###########################
-#######################################################################
-# Look up a stock's price on the TSE using the Telenium service
-#######################################################################
-sub get_TSE {
- local ($stock) = @_;
- local ($page) = "http://www.telenium.ca/TSE/" .
-
- lc(
- substr($stock, 0, 1)
- )
- . ".html";
- if ($OLD{$stock} eq "NO!") { # We've already priced this stock
- return;
- }
- local ($command) = &get_url_command($page) . " | grep ' $stock'";
- local ($line);
- open(GETPAGE, "$command |");
-# open(GETPAGE, "<a:/t~1.htm");
- while ($line = <GETPAGE>) {
- chop $line;
-# print $line, "\n";
- if ($line =~ /(\d*\.\d*)\D+\d+\S*\s+\d+\s+\S+\s+\d+\/\d+\s+(\S*)\s*$/) {
- local($lp, $ls) = (sprintf("%.4f", $1), $2);
-
-# print "Found $ls @ $lp\n";
- #... 21.3 21.35 21.2 21.2 -0.15 142300 193 02/14 T
- #... 19.4 19.5 19.2 19.35-0.1 687239 181 02/04 T
- #... 51.5 52 50.6 51.4 0 1527378 583 02/05 RY
-
- #... 1.18 1.2 1.1 1.2 0.02 44700 29 02/03 NBX
- # ^^^
- # Want this "close" value...
- if ($lp < 0.001) {
- # Do nothing
- } elsif ($ls eq $stock) {
- if ((($lp * 1.0) != $PRICE{$stock}) && ($price > 0)) {
- $newprices = "YES";
- $PRICE{$stock} = sprintf("%.4f", $price);
- print "NEW PRICE: $stock, $lp\n";
- } else {
- $price = $PRICE{$stock};
- }
- $PRICE{$stock} = sprintf("%.4f", $lp);
- $OLD{$stock} = "NO!"; # Indicate that this is an update...
- }
- }
- }
- close GETPAGE;
-}
-
-#######################################################################
-############################ &get_yahoo(); ############################
-#######################################################################
-# Look up a stock via "yahoo"
-#######################################################################
-sub get_yahoo {
- local ($stock, $exchange) = @_;
- local ($price);
- if (($exchange eq "NY") || ($exchange eq "NYSE")) {
- $exchange = "";
- }
- if ($exchange eq "TSE") {
- $exchange = ".TO";
- }
- local ($page) = "http://quote.yahoo.com/download/quotes.csv?symbols=" .
-
- $stock . $exchange .
- "&format=sl1d1t1c1ohgv&ext=.csv";
- if ($OLD{$stock} eq "NO!") { # We've already priced this stock
- return;
- }
- local ($command) = &get_url_command($page);
- local ($line);
-# print $command, "\n";
- open(GETPAGE, "$command |");
- while ($line = <GETPAGE>) {
-# print "$line";
- local ($trash, $price)=split(/,/, $line);
-# print "$trash, $price\n";
-# print "Old price: ", $PRICE{$stock}, "\n";
- if ((($price * 1.0) != $PRICE{$stock}) && ($price > 0) ) {
- $newprices = "YES";
- print "NEW PRICE: $stock, $price\n";
- } else {
- $price = $PRICE{$stock};
-# print "Keep old price: $price\n";
- }
- $PRICE{$stock} = sprintf("%.4f", $price);
- $OLD{$stock} = "NO!"; # Indicate that this is an update...
-# print "Done - ", $stock, $PRICE{$stock}, $OLD{$stock}, "\n";
- }
-}
-
-#######################################################################
-########################## &get_CT_Everest(); #########################
-#######################################################################
-# Look up all of the CT Everest mutual fund prices
-#######################################################################
-sub get_CT_Everest {
- local ($line, $fund, $value);
- local ($url) = "http://www.canadatrust.com/test/ctrates/EV.html";
- local ($command) = &get_url_command($url);
- open(FUNDS, "$command |");
- while ($line = <FUNDS>) {
- if ($line =~ /.*\s+\d+.\d+\s+\d+.\d+\s+.\d+.\d+/) {
-# print "CT: $line";
- $fund = substr($line, 0, 15);
-# print "fund: [", $fund, "] ID:[", $ID{$fund}, "]\n";
- if ($ID{$fund} ne "") {
- $value = substr($line, 30, 11);
- if (($value*1.0) != $PRICE{$ID{$fund}}) {
- $newprices = "YES";
- print "NEW PRICE: $fund, $value\n";
-
- }
-
- $PRICE{$ID{$fund}} = $value;
- $OLD{$ID{$fund}} = "NO!"; # Indicate that this is an update...
-# print "CT Price: $value ", $ID{$fund}, "\n";
- }
- }
- }
- close FUNDS;
-}
-
-#######################################################################
-############################## &get_WV(); #############################
-#######################################################################
-# Look up Working Ventures fund price
-#######################################################################
-sub get_WV {
- local ($url) = "http://www.workingventures.ca/main_cell.html";
- local ($command) = &get_url_command($url) . " | grep 'share price' ";
- open(FUNDS, "$command |");
- while (<FUNDS>) {
- if (/\D+\$(\d+\.\d+)\D+/) {
- # matches .... $13.66 ...
- if (($1 * 1.0) != $PRICE{"WORKVE"}) {
- $newprices = "YES";
- print "NEW PRICE: WV, $1\n";
- }
-
- $PRICE{"WORKVE"} = sprintf("%.4f", $1);
- $OLD{"WORKVE"} = "NO!"; # Indicate that this is an update...
- }
- }
- close FUNDS;
-}
-
-#######################################################################
-########################### &ct_fund_ids (); ##########################
-#######################################################################
-# Build an associative array that lets one take the names used in the
-# CT mutual fund web page, and associate them with the short forms
-# used as "ticker" codes
-#######################################################################
-sub ct_fund_ids {
- %ID = ("MONEY MARKET ", "CTMM",
- "PREMIUM MMF ", "CTPMM",
- "SHORT TERM BND ", "CTSTB",
- "MORTGAGE ", "CTMTG",
- "BALANCED ", "CTBAL",
- "BOND ", "CTBOND",
- "DIV INCOME ", "CTDIV",
- "STOCK ", "CTSTK",
- "SPECIAL EQUITY ", "CTSPEC",
- "INT'L BOND ", "CTIBND",
- "NORTH AMERICAN ", "CTNA",
- "AMERIGROWTH ", "CTAMER",
- "U.S. EQUITY ", "CTUSEQ",
- "ASIAGROWTH ", "CTASIA",
- "EUROGROWTH ", "CTEURO",
- "GLOBALGROWTH ", "CTGLOB",
- "INT'L EQUITY ", "CTINTL",
- "EMERGING MKTS. ", "CTEMER"
- );
-}
-
-
-#######################################################################
-############################ &save_prices()############################
-#######################################################################
-# Dump data out to a file
-#######################################################################
-sub save_prices {
- local ($date) = `date '+%Y/%m/%d-%H:%M:%S'`;
- chop $date;
- local ($ticker, $price);
- open(HISTPRICES, ">>$HISTORYFILE");
- while ($ticker = each %PRICE) {
- if ($OLD{$ticker} eq "yes") {
- # Don't dump it; we didn't get a new price...
- } else {
- $key = $date . "" . $ticker;
- $price = $PRICE{$ticker};
- print HISTPRICES $date, "|", $ticker, "|", $price, "\n";;
- }
- }
- close HISTPRICES;
-}
-
-#######################################################################
-########################### &load_prices();############################
-#######################################################################
-# Preload prices, thus always keeping around the latest successfully
-# located price.
-# This means that if the web search process fails, we still do have
-# pricing, even if it's somewhat out of date...
-#######################################################################
-sub load_prices {
- local ($date) = `date '+%Y/%m/%d-%H:%M:%S'`;
- chop $date;
- local ($ticker, $price, $line);
- open(HISTPRICES, "<$HISTORYFILE");
- while ($line = <HISTPRICES>) {
- ($date, $ticker, $price) = split(/\|/, $line);
- $PRICE{$ticker} = $price;
- $OLD{$ticker} = "yes"; # Indicate that this is an old price
- # and thus not to be redumped
- }
- close HISTPRICES;
-}
-
-
-
-#######################################################################
-############################ &show_report();###########################
-#######################################################################
-# Look up all of the securities, and build a report listing the cost,
-# value, and net profit/loss on each security, along with totals.
-########################################################################
-sub show_report {
- local($date) = `date`;
- chop $date;
- local($ticker, $shares, $price, $value, $cost, $profitloss);
- local ($tp, $tv, $tc);
-format STDOUT_TOP =
- Portfolio Valuation
- as at @<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$date
-Ticker Shares Recent Price Value Cost Profit/Loss
-------------------------------------------------------------------------
-.
-
-
-format STDOUT =
-@<<<<<<< @>>>>>>> @>>>>>>>> @>>>>>>>>>>> @>>>>>>>>>>> @>>>>>>>>>>>>
-$ticker, $shares, $price, $value, $cost, $profitloss
-.
-
-
- foreach $stock (sort keys EXCHANGE) {
- if ($stock ne "zPortfolio") {
- $ticker = $stock;
- $shares = sprintf("%.4f", $NUM{$stock});
- $price = sprintf("%.4f", $PRICE{$stock});
- $value = sprintf("%.2f", $shares * $price * $CURRATE{$CURRENCY{$stock}});
- $cost = sprintf("%.2f", $COST{$stock} * $CURRATE{$CURRENCY{$stock} });
- $profitloss = sprintf("%.2f", $value - $cost);
- $tv += $value;
- $tc += $cost;
- $tp += $profitloss;
- write;
- }
- }
-
-($ticker, $shares, $price, $value, $cost, $profitloss) =
- ("", "", "", "---------------", "---------------", "---------------");
-write;
-
-($ticker, $shares, $price, $value, $cost, $profitloss) =
- ("Total", "", "", sprintf("%.2f", $tv), sprintf("%.2f" ,$tc),
- sprintf("%.2f" ,$tp));
-
-write;
-($ticker, $shares, $price, $value, $cost, $profitloss) =
- ("", "", "", "===============", "===============", "===============");
-write;
-}
-
-
-
-#########################################################################=
-#####
-############################## Find Variances #########################=
-#####
-#########################################################################=
-#####
-sub calc_variances {
- local ($x);
- open(PRICEF, "<$HISTORYFILE");
- while (<PRICEF>) {
- ($date, $id, $price) = split(/\|/, $_);
- $XCOUNT{$id} ++;
- $quantity = $NUM{$id};
- $x = $quantity * $price * $CURRATE{$CURRENCY{$id}};
- $XSUM{$id} += $x;
- $XSQUARESUM{$id} += ($x * $x);
-
- $DATES{$date} ++;
- $PRICES{"$date|$id"} = $price;
-# printf "XC: %9.2f XSUM: %9.2f XSQ: %9.2f\n", $XCOUNT{$id}, $XSUM{$id}, $XSQUARESUM{$id};
- }
-
- &complete_price_list(); # Get prices for *every* day
- &value_portfolios(); # Value the portfolio for every day
-}
-
-# Need to make sure that we have prices for each stock for each date
-# This is done by (for each stock) going thru all the dates, and
-# inserting prices for dates where prices are missing. We use the
-# last price present for the stock.
-sub complete_price_list {
- foreach $stock (keys XCOUNT) {
- $current_price = $XSUM{$stock} / $XCOUNT{$stock};
-
- # Move forwards until a price gets found. That price
- # is then used for all "empty" price slots up to the first
- # actual measurement
- FIRSTPRICE:
- foreach $date (sort keys DATES) {
- if ($PRICES{"$date|$stock"}) {
- $current_price = $PRICES{"$date|$stock"};
- last FIRSTPRICE;
- }
- }
-
- # Now, proceed onwards...
- foreach $date (sort keys DATES) {
- if ($PRICES{"$date|$stock"}) {
- # There's a price
- $current_price = $PRICES{"$date|$stock"};
- } else {
- $PRICES{"$date|$stock"} = $current_price;
- }
- }
- }
-}
-
-sub value_portfolios {
-# &setup_portfolio_quantities();
- $NUM{"zPortfolio"}=1;
- foreach $date (sort keys DATES) {
- $price = 0;
- foreach $stock (keys XCOUNT) {
- $price += $NUM{$stock} * $PRICES{"$date|$stock"}* $CURRATE{$CURRENCY{$stock}};
- }
- $XCOUNT{"zPortfolio"} ++;
- $XSUM{"zPortfolio"} += $price;
- $XSQUARESUM{"zPortfolio"} += ($price * $price);
-# printf "Portfolio on %15s valued at %14.2f\n", $date, $price;
-
- }
-}
-
-sub hilo_portfolios {
- local($date, $hi, $lo, $hival, $loval);
- local ($stock, $price, $latest_date);
- foreach $stock (keys XCOUNT) {
- $LO{$stock} = 99999999;
- $HI{$stock} = -99999999;
- }
- $HI{"zPortfolio"} = -99999999;
- $LO{"zPortfolio"} = 99999999;
- foreach $date (keys DATES) {
- local ($pprice);
- local($dt) = split(/-/, $date);
- foreach $stock (keys XCOUNT) {
- $price = $PRICES{"$date|$stock"};
- if ($date >= $latest_date) {
- $latest_date = $date;
- $CURRENT{$stock} = $price;
- }
- if ($price > $HI{$stock}) {
- ($HI{$stock}, $HIDATE{$stock}) = ($price, $dt);
- }
- if ($price < $LO{$stock}) {
- ($LO{$stock}, $LODATE{$stock}) = ($price, $dt);
- }
- $pprice += $NUM{$stock} * $price;
- }
- if ($date >= $latest_date) {
- $latest_date = $date;
- $CURRENT{"zPortfolio"} = $pprice;
- }
- if ($pprice > $HI{"zPortfolio"}) {
- ($HI{"zPortfolio"}, $HIDATE{"zPortfolio"}) = ($pprice, $dt);
- }
- if ($pprice > $LO{"zPortfolio"}) {
- ($LO{"zPortfolio"}, $LODATE{"zPortfolio"}) = ($pprice, $dt);
- }
- }
- # Report results...
- print
-"-----------------------------------------------------------------------
- Highs/Lows
------------------------------------------------------------------------
-";
- printf "%10s %10s %10s %10s %10s %10s\n", "Stock", "High Date", "High",
- "Low Date", "Low Price", "Current";
- print "-----------------------------------------------------------------------";
- foreach $stock (sort keys XCOUNT) {
- printf "%10s %10s %10.2f %10s %10.2f %10.2f\n", $stock, $HIDATE{$stock},
- $HI{$stock}, $LODATE{$stock}, $LO{$stock}, $CURRENT{$stock};
- }
- print "-----------------------------------------------------------------------";
-
-}
-
-sub show_variances {
- print
- "-----------------------------------------------------------------------
- Variance/Standard Deviations for Portfolio *VALUE*
-------------------------------------------------------------------------
- Security Mean Variance Std. Dev. % Std.Dev
-------------------------------------------------------------------------
-";
-
- foreach $i (sort keys XCOUNT) {
- if ($XCOUNT{$i} > 2) {
- $variance = (($XCOUNT{$i} * $XSQUARESUM{$i})
- - ($XSUM{$i} * $XSUM{$i})) /
- ($XCOUNT{$i} * ($XCOUNT{$i}-1));
-
- }
- $variance = -$variance if ($variance < 0);
- $deviation = sqrt($variance);
-
-# printf "XC: %5d XSUM: %9.2f XSQ: %9.2f\n", $XCOUNT{$i}, $XSUM{$i}, $XSQUARESUM{$i};
- # Divide by mean price to determine volatility of price
- if ($XCOUNT{$i} != 0 && $XSUM{$i} != 0) {
- $volatility = $deviation / ($XSUM{$i} / $XCOUNT{$i});
- printf "%10s %10.2f %14.3f %9.3f %9.3f\n", $i, $XSUM{$i}/$XCOUNT{$i},
- $variance, $deviation,
- $volatility *100;
-
- ($VARIANCE{$i}, $STD{$i}, $VOLATILITY{$i}) = ($variance, $deviation,
- $volatility);
- }
- }
- print "------------------------------------------------------------------------";
-
-}
-
-sub get_currency {
- local ($to) = @_;
- local($url) =
- "http://www.dna.lth.se/cgi-bin/kurt/rates/rates?CAD+$to";
- local($line, $rate);
- local ($command) = &get_url_command($url);
-
- local($fromname, $toname) = ($CURRNAME{"CDN"}, $CURRNAME{$to});
- open(CURRS, "$command |");
- while ($line = <CURRS>) {
- if ($line =~ /Rate: $fromname.*$toname.*:\s*(\d*.\d+)/) {
- $rate = $1;
- $CURRATE{$toname} = sprintf("%f", $rate);
- return;
- }
- }
-}
-
Modified: gnucash/trunk/src/scm/price-quotes.scm
===================================================================
--- gnucash/trunk/src/scm/price-quotes.scm 2006-02-19 20:52:10 UTC (rev 13302)
+++ gnucash/trunk/src/scm/price-quotes.scm 2006-02-19 22:16:49 UTC (rev 13303)
@@ -31,6 +31,7 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash main) (g-wrapped gw-gnc)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
+(use-modules (g-wrapped gw-core-utils))
(use-modules (g-wrapped gw-gnome-utils))
(gnc:module-load "gnucash/app-utils" 0)
@@ -242,7 +243,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define gnc:*finance-quote-check*
- (gnc:gnome-locate-data-file "finance-quote-check"))
+ (g:find-program-in-path "gnc-fq-check"))
(define (gnc:fq-check-sources)
(let ((program #f))
@@ -290,7 +291,7 @@
;; src/engine/gnc-pricedb.h
(define gnc:*finance-quote-helper*
- (gnc:gnome-locate-data-file "finance-quote-helper"))
+ (g:find-program-in-path "gnc-fq-helper"))
(define (gnc:fq-get-quotes requests)
;; requests should be a list where each item is of the form
@@ -310,7 +311,7 @@
;; symbol if the corresponding method call fails, or a list
;; otherwise. A quote-result list will contain the symbol
;; representing the item being quoted, followed by an alist
- ;; detailing the quote data from finance-quote-helper.
+ ;; detailing the quote data from gnc-fq-helper.
;;
;; Possible error symbols and their meanings are:
;; missing-lib One of the required perl libs is missing
@@ -327,7 +328,7 @@
;;
;; Also note that any given value in the alist might be
;; 'failed-conversion if the Finance::Quote result for that field
- ;; was unparsable. See the finance-quote-helper for more details
+ ;; was unparsable. See the gnc-fq-helper for more details
;; about it's output.
(let ((quoter #f))
@@ -387,7 +388,7 @@
;; Finance::Quote method.
;;
;; Returns a list of the info needed for a set of calls to
- ;; finance-quote-helper. Each item will of the list will be of the
+ ;; gnc-fq-helper. Each item will of the list will be of the
;; form:
;;
;; (("yahoo" (commodity-1 currency-1 tz-1)
@@ -418,7 +419,7 @@
;; Now collect symbols going to the same backend.
(item-list->hash! commodity-list quote-hash car cdr hash-ref hash-set! #t)
- ;; Now translate to just what finance-quote-helper expects.
+ ;; Now translate to just what gnc-fq-helper expects.
(append
(hash-fold
(lambda (key value prior-result)
@@ -645,9 +646,9 @@
(if (gnc:ui-is-running?)
(gnc:error-dialog #f
(_ "You are missing some needed Perl libraries.
-Run 'update-finance-quote' as root to install them."))
+Run 'gnc-fq-update' as root to install them."))
(gnc:warn (_ "You are missing some needed Perl libraries.
-Run 'update-finance-quote' as root to install them.") "\n")))
+Run 'gnc-fq-update' as root to install them.") "\n")))
((member 'system-error fq-results)
(set! keep-going? #f)
(if (gnc:ui-is-running?)
More information about the gnucash-changes
mailing list