Paul Fenwick's Quote.pm patch.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2399 57a11ea4-9604-0410-9ed3-97b8803252fd
zzzoldreleases/1.4
Dave Peticolas 26 years ago
parent 4f33e6f259
commit 52e00f615b

@ -4,7 +4,7 @@
# Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
# Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
# Copyright (C) 2000, Paul Fenwick <pjf@schools.net.au>
# Copyright (C) 2000, Brent Neal <brent@phys.lsu.edu>
# Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
#
# 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
@ -26,36 +26,64 @@
# but extends its capabilites to encompas a greater number of data sources.
#
# This code was developed as part of GnuCash <http://www.gnucash.org/>
#
#
# ==========================================================================
#
# NOTE: This is a special GnuCash release of Finance::Quote,
# and operates slightly differently to the 0.18
# release of Finance::Quote. The main two changes
# are that the package is called "Quote" and not
# Finance::Quote, and that all functions now implement
# a "price" label in the hash they return.
#
# For more information about Finance::Quote, visit:
# http://finance-quote.sourceforge.net/
#
# ==========================================================================
#
# package Finance::Quote;
package Quote;
require 5.004;
use strict;
# These should really be moved to near their corresponding functions,
# and possibly wrapped into lexical my's around the functions similar
# to what's been done with fetch.
#
# Of course, it would also make sense to move a lot of these methods
# into their own seperate sub-modules. Much cleaner and nicer that
# way.
use vars qw($VERSION @EXPORT @ISA $TIMEOUT @EXPORT_OK @EXPORT_TAGS
$YAHOO_URL $YAHOO_EUROPE_URL
$FIDELITY_GANDI_URL $FIDELITY_GROWTH_URL $FIDELITY_CORPBOND_URL
$FIDELITY_GLBND_URL $FIDELITY_MM_URL $FIDELITY_ASSET_URL
$TROWEPRICE_URL
$TROWEPRICE_URL $YAHOO_CURRENCY_URL
$VANGUARD_QUERY_URL $VANGUARD_CSV_URL @vanguard_ids
$ASX_URL $TIAACREF_URL %tiaacref_ids);
use LWP::UserAgent;
use HTTP::Request::Common;
use Carp;
use Exporter ();
# Export information
# Export information. Allow lots of things to be exported, but not
# by default.
@ISA = qw/Exporter/;
@EXPORT = ();
@EXPORT_OK = qw/yahoo yahoo_europe fidelity troweprice vanguard asx tiaacref/;
@EXPORT_OK = qw/yahoo yahoo_europe fidelity troweprice asx tiaacref fetch/;
@EXPORT_TAGS = ( all => [@EXPORT_OK] );
$VERSION = '0.17';
$VERSION = '0.18';
# URLs of where to obtain information.
$YAHOO_URL = ("http://quote.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1&s=");
$YAHOO_URL = ("http://quote.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1q&s=");
$YAHOO_EUROPE_URL = ("http://finance.fr.yahoo.com/d/quotes.csv?f=snl1d1t1c1p2va2bapomwerr1dyj1&s=");
$YAHOO_CURRENCY_URL = ("http://finance.yahoo.com/m5?");
$FIDELITY_GANDI_URL = ("http://personal441.fidelity.com/gen/prices/gandi.csv");
$FIDELITY_GROWTH_URL = ("http://personal441.fidelity.com/gen/prices/growth.csv");
$FIDELITY_CORPBOND_URL = ("http://personal441.fidelity.com/gen/prices/corpbond.csv");
@ -90,11 +118,44 @@ sub timeout {
$TIMEOUT = $timeout;
}
# =======================================================================
# Fetch is a wonderful generic fetcher. It takes a method and stuff to
# fetch. It's a nicer interface for when you have a list of stocks with
# different sources which you wish to deal with.
{
# Private hash used by fetch. We don't place it inside the
# fetch function because then it gets rebuilt every time we
# run fetch. We don't place it at the top-level because that
# means other things that shouldn't care can play with it.
my %methods = ( asx => \&asx,
fidelity => \&fidelity,
tiaacref => \&tiaacref,
troweprice => \&troweprice,
yahoo => \&yahoo,
nasdaq => \&yahoo,
nyse => \&yahoo,
yahoo_europe => \&yahoo_europe,
europe => \&yahoo_europe,
vanguard => \&yahoo );
sub fetch {
shift if ref ($_[0]); # Shift off the object if there is one.
my $method = lc(shift);
my @stocks = @_;
unless (exists $methods{$method}) {
carp "Undefined fetch-method $method passed to ".
"Finance::Quote::fetch";
return undef;
}
return &{$methods{$method}}(@stocks);
}
}
# =======================================================================
# Grabbed from the Perl Cookbook. Parsing csv isn't as simple as you thought!
#
# Obsoleted code? I can't see this being called anywhere.
#
sub _parse_csv
{
my $text = shift; # record containing comma-separated values
@ -119,6 +180,7 @@ sub yahoo
{
shift if (ref $_[0]); # Shift off the object if there is one.
my @symbols = @_;
return undef unless @symbols; # Nothing if no symbols.
my($x,@q,%aa,$ua,$url,$sym);
$x = $";
@ -128,27 +190,62 @@ sub yahoo
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
foreach (split('\015?\012',$ua->request(GET $url)->content))
my $reply = $ua->request(GET $url);
return undef unless ($reply->is_success);
foreach (split('\015?\012',$reply->content))
{
@q = _parse_csv($_);
$sym = $q[0];
$aa {$sym, "exchange"} = "NYSE"; # new york stock exchange
$aa {$sym, "name"} = $q[1];
$aa {$sym, "last"} = $q[2];
$aa {$sym, "date"} = $q[3];
$aa {$sym, "time"} = $q[4];
$aa {$sym, "net"} = $q[5];
$aa {$sym, "p_change"} = $q[6];
$aa {$sym, "volume"} = $q[7];
$aa {$sym, "avg_vol"} = $q[8];
$aa {$sym, "bid"} = $q[9];
$aa {$sym, "ask"} = $q[10];
$aa {$sym, "close"} = $q[11];
$aa {$sym, "open"} = $q[12];
$aa {$sym, "day_range"} = $q[13];
$aa {$sym, "year_range"} = $q[14];
$aa {$sym, "eps"} = $q[15];
$aa {$sym, "pe"} = $q[16];
$aa {$sym, "div_date"} = $q[17];
$aa {$sym, "div"} = $q[18];
$aa {$sym, "div_yield"} = $q[19];
$aa {$sym, "cap"} = $q[20];
$aa {$sym, "ex_div"} = $q[21];
$aa {$sym, "price"} = $aa{$sym,"last"};
# Yahoo returns a line filled with N/A's if we look up a
# non-existant symbol. AFAIK, the date flag will /never/
# be defined properly unless we've looked up a real stock.
# Hence we can use this to check if we've successfully
# obtained the stock or not.
if ($aa{$sym,"date"} eq "N/A") {
$aa{$sym,"success"} = 0;
$aa{$sym,"errormsg"} = "Stock lookup failed";
} else {
$aa{$sym,"success"} = 1;
}
if ($q[13] =~ m{^"?\s*(\S+)\s*-\s*(\S+)"?$}) {
$aa {$sym, "low"} = $1;
$aa {$sym, "high"} = $2;
}
}
# Return undef's rather than N/As. This makes things more suitable
# for insertion into databases, etc.
foreach my $key (keys %aa) {
undef $aa{$key} if (defined($aa{$key}) and $aa{$key} eq "N/A");
}
# return wantarray() ? @qr : \@qr;
return %aa;
}
@ -158,6 +255,7 @@ sub yahoo_europe
{
shift if (ref $_[0]); # Shift off the object if there is one.
my @symbols = @_;
return undef unless @symbols; # Nothing if no symbols.
my($x,@q,%aa,$ua,$url,$sym);
$x = $";
@ -167,7 +265,9 @@ sub yahoo_europe
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
foreach (split('\015?\012',$ua->request(GET $url)->content))
my $reply = $ua->request(GET $url);
return undef unless ($reply->is_success);
foreach (split('\015?\012',$reply->content))
{
@q = _parse_csv($_);
@ -185,6 +285,27 @@ sub yahoo_europe
$aa {$sym, "eps"} = $q[15];
$aa {$sym, "pe"} = $q[16];
$aa {$sym, "cap"} = $q[20];
$aa {$sym, "price"} = $aa{$sym,"last"};
# Yahoo returns a line filled with N/A's if we look up a
# non-existant symbol. AFAIK, the date flag will /never/
# be defined properly unless we've looked up a real stock.
# Hence we can use this to check if we've successfully
# obtained the stock or not.
if ($aa{$sym,"date"} eq "N/A") {
$aa{$sym, "success"} = 0;
$aa{$sym, "errormsg"} = "Stock lookup failed.";
} else {
$aa{$sym, "success"} = 1;
}
}
# Return undef's rather than N/As. This makes things more suitable
# for insertion into databases, etc. Also remove silly HTML that
# yahoo inserts to put in little euro symbols.
foreach my $key (keys %aa) {
$aa{$key} =~ s/<[^>]*>//g;
undef $aa{$key} if (defined($aa{$key}) and $aa{$key} eq "N/A");
}
# return wantarray() ? @qr : \@qr;
@ -198,6 +319,7 @@ sub fidelity
{
shift if (ref $_[0]); # Shift off the object if there is one.
my @symbols = @_;
return undef unless @symbols;
my(%aa,%cc,$sym, $k);
# rather irritatingly, fidelity sorts its funds into different groups.
@ -237,42 +359,42 @@ sub fidelity
for (@symbols) {
if ($agandi {$_} ) {
if (0 == $dgandi ) {
%cc = &fidelity_nav ($FIDELITY_GANDI_URL);
%cc = &_fidelity_nav ($FIDELITY_GANDI_URL);
$dgandi = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
}
if ($agrowth {$_} ) {
if (0 == $dgrowth ) {
%cc = &fidelity_nav ($FIDELITY_GROWTH_URL);
%cc = &_fidelity_nav ($FIDELITY_GROWTH_URL);
$dgrowth = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
}
if ($acorpbond {$_} ) {
if (0 == $dcorpbond ) {
%cc = &fidelity_nav ($FIDELITY_CORPBOND_URL);
%cc = &_fidelity_nav ($FIDELITY_CORPBOND_URL);
$dcorpbond = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
}
if ($aglbnd {$_} ) {
if (0 == $dglbnd ) {
%cc = &fidelity_nav ($FIDELITY_GLBND_URL);
%cc = &_fidelity_nav ($FIDELITY_GLBND_URL);
$dglbnd = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
}
if ($amm {$_} ) {
if (0 == $dmm ) {
%cc = &fidelity_mm ($FIDELITY_MM_URL);
%cc = &_fidelity_mm ($FIDELITY_MM_URL);
$dmm = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
}
if ($aasset {$_} ) {
if (0 == $dasset ) {
%cc = &fidelity_nav ($FIDELITY_ASSET_URL);
%cc = &_fidelity_nav ($FIDELITY_ASSET_URL);
$dasset = 1;
foreach $k (keys %cc) { $aa{$k} = $cc{$k}; }
}
@ -283,8 +405,9 @@ sub fidelity
}
# =======================================================================
# Private function used by fidelity.
sub fidelity_nav
sub _fidelity_nav
{
shift if (ref $_[0]); # Shift off the object if there is one.
my(@q,%aa,$ua,$url,$sym, $dayte);
@ -297,13 +420,15 @@ sub fidelity_nav
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
foreach (split('\015?\012',$ua->request(GET $url)->content))
my $reply = $ua->request(GET $url);
return undef unless ($reply->is_success);
foreach (split('\015?\012',$reply->content))
{
@q = _parse_csv($_);
@q = _parse_csv($_) or next;
# extract the date which is usually on the second line fo the file.
if (! defined ($dayte)) {
if ( $days {$q[0]} ) {
if ($days {$q[0]} ) {
($dayte = $q[1]) =~ s/^ +//;
}
}
@ -317,16 +442,19 @@ sub fidelity_nav
($aa {$sym, "nav"} = $q[3]) =~ s/^ +//;
($aa {$sym, "change"} = $q[4]) =~ s/^ +//;
($aa {$sym, "ask"} = $q[7]) =~ s/^ +//;
$aa {$sym, "date"} = $dayte;
}
$aa {$sym, "date"} = $dayte;
$aa {$sym, "price"} = $aa {$sym, "nav"};
$aa {$sym, "success"} = 1;
}
}
return %aa;
}
# =======================================================================
# Private function used by fidelity.
sub fidelity_mm
sub _fidelity_mm
{
shift if (ref $_[0]); # Shift off the object if there is one.
my(@q,%aa,$ua,$url,$sym, $dayte);
@ -339,13 +467,15 @@ sub fidelity_mm
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
foreach (split('\015?\012',$ua->request(GET $url)->content))
my $reply = $ua->request(GET $url);
return undef unless ($reply->is_success);
foreach (split('\015?\012',$reply->content))
{
@q = _parse_csv($_);
@q = _parse_csv($_) or next;
# extract the date which is usually on the second line fo the file.
if (! defined ($dayte)) {
if ( $days {$q[0]} ) {
if ($days {$q[0]} ) {
($dayte = $q[1]) =~ s/^ +//;
}
}
@ -357,8 +487,12 @@ sub fidelity_mm
$aa {$sym, "name"} =~ s/$ +//;
($aa {$sym, "number"} = $q[1]) =~ s/^ +//;
($aa {$sym, "yield"} = $q[3]) =~ s/^ +//;
$aa {$sym, "date"} = $dayte;
}
$aa {$sym, "date"} = $dayte;
# Yield doesn't seem to make a great deal of sense
# for the "price" field, but it's the best there is.
$aa {$sym, "price"} = $aa {$sym, "yield"};
$aa {$sym, "success"} = 1;
}
}
return %aa;
@ -376,7 +510,9 @@ sub troweprice
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
foreach (split('\015?\012',$ua->request(GET $url)->content))
my $reply = $ua->request(GET $url);
return undef unless ($reply->is_success);
foreach (split('\015?\012',$reply->content))
{
@q = _parse_csv($_);
@ -388,14 +524,21 @@ sub troweprice
$aa {$sym, "name"} = $sym; # no name supplied ...
$aa {$sym, "nav"} = $q[1];
$aa {$sym, "date"} = $q[2];
}
$aa {$sym, "price"} = $aa {$sym, "nav"};
$aa {$sym, "success"} = 1;
} else {
$aa {$sym, "success"} = 0;
$aa {$sym, "errormsg"} = "Stock lookup failed.";
}
}
return %aa;
}
# =======================================================================
# The Vanguard function is depreciated and no longer works due to a
# re-structure of the Vanguard website. We hope to fix this in the
# future.
sub vanguard
{
shift if (ref $_[0]); # Shift off the object if there is one.
@ -502,6 +645,7 @@ sub vanguard
}
my @symbols = @_;
return undef unless @symbols;
my($url, $sym, $i, $fid, $reply, $ua, @q, %aa);
# convert ticker symbols into fund numbers; build first url
@ -581,6 +725,7 @@ sub vanguard
sub asx {
shift if (ref $_[0]); # Shift off the object if there is one.
my @stocks = @_;
return undef unless @stocks;
my %info;
my $ua = LWP::UserAgent->new;
@ -588,13 +733,25 @@ sub asx {
$ua->env_proxy();
foreach my $stock (@stocks) {
my $reply = $ua->request(GET $ASX_URL.$stock)->content;
my $response = $ua->request(GET $ASX_URL.$stock);
unless ($response->is_success) {
$info{$stock,"success"} = 0;
$info{$stock,"errormsg"} = "HTTP session failed";
next;
}
my $reply = $response->content;
# Grab the date. This is a pretty clunky way of doing it, but
# my mind's still in brain-saver mode.
my ($day, $month, $year) = $reply =~ /(\d\d?) (January|February|March|April|May|June|July|August|September|October|November|December) (\d{4})/;
unless ($month) {
$info{$stock,"sucess"} = 0;
$info{$stock,"errormsg"} = "Symbol Lookup failed";
next;
}
$_ = $month;
(s/January/1/ or
s/February/2/ or
@ -607,7 +764,7 @@ sub asx {
s/September/9/ or
s/October/10/ or
s/November/11/ or
s/December/12/ or (warn "Bizzare month $_ from ASX. Skipped $stock\n"
s/December/12/ or (warn "Bizarre month $_ from ASX. Skipped $stock\n"
and return undef));
$info{$stock,"date"} = "$_/$day/$year"; # Silly 'merkin format.
@ -676,6 +833,8 @@ sub asx {
# Outside of business hours, the last price is the same as the
# previous day's close.
$info{$stock,"last"} ||= $info{$stock,"close"};
$info{$stock, "price"} = $info{$stock,"last"};
$info{$stock,"success"} = 1;
}
return %info;
}
@ -726,35 +885,87 @@ sub tiaacref
$tiaacref_ids{"TIAAsndx"} = "TIAA Teachers Personal Annuity Stock Index";
$tiaacref_ids{"TIAAsele"} = "TIAA Teachers Personal Annuity Select Stock";
}
my(@funds) = @_;
return undef unless @funds;
my(@line); #holds the return from _parse_csv
my(%info);
my(%info);
my(%check); #holds success value if data returned
my($ua,$url); #useragent and target url
my($data); #the reply from TIAA-CREF's cgi
my(@funds) = @_;
my($reply); #the reply from TIAA-CREF's cgi
$url = $TIAACREF_URL;
foreach my $fund (@funds) {
if ($tiaacref_ids{$fund}) {
$url .= $fund . "=yes&";
$check{$fund} = 0;
} else {
$info{$fund,"success"} = 0;
$info{$fund,"errormsg"} = "Bad symbol";
}
}
$url .= "selected=1";
$ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
$data = $ua->request(GET $url)->content;
foreach (split('\012',$data) ){
@line = _parse_csv($_);
$info{$line[0],"symbol"} = $line[0]; #in case the caller needs this in the hash
$info{$line[0],"exchange"} = "TIAA-CREF";
$info{$line[0],"name"} = $tiaacref_ids{$line[0]};
$info{$line[0],"date"} = $line[2];
$info{$line[0],"nav"} = $line[1];
$reply = $ua->request(GET $url);
if ($reply ->is_success) {
foreach (split('\012',$reply->content) ){
@line = _parse_csv($_);
if (exists $check{$line[0]}) { #did we ask for this data?
$info{$line[0],"symbol"} = $line[0]; #in case the caller needs this in the hash
$info{$line[0],"exchange"} = "TIAA-CREF";
$info{$line[0],"name"} = $tiaacref_ids{$line[0]};
$info{$line[0],"date"} = $line[2];
$info{$line[0],"nav"} = $line[1];
$info{$line[0],"price"} = $info{$line[0],"nav"};
$info{$line[0],"success"} = 1; #this contains good data, beyond a reasonable doubt
$check{$line[0]} = 1;
} else {
$info{$line[0],"success"} = 0;
$info{$line[0],"errormsg"} = "Bad data returned";
}
}
} else {
foreach $_ (@funds) {
$info{$_,"success"} = 0;
$info{$_,"errormsg"} = "HTTP error";
} # foreach
} #if $reply->is_success else
#now check to make sure a value was returned for every symbol asked for
foreach my $k (keys %check) {
if ($check{$k} == 0) {
$info{$k,"success"} = 0;
$info{$k,"errormsg"} = "No data returned";
}
}
return %info;
}
# Currency allows the user to convert from one currency to another.
# WARNING - This function is still under development. Use at your
# own risk. This function's interface and behaviour can
# and WILL change in the future.
sub currency {
shift if (ref($_[0])); # Pop the object if we have one.
my ($from, $to) = @_;
return undef unless ($from and $to);
my $ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT) if defined $TIMEOUT;
$ua->env_proxy();
my $data = $ua->request(GET "${YAHOO_CURRENCY_URL}s=$from&t=$to")->content;
my ($exchange) = $data =~ m#$from$to=X</a></td><td>1</td><td>\d\d?:\d\d\w\w</td><td>(\d+\.\d+)</td>#;
return ( from => $from, to => $to, exchange => $exchange );
}
# =======================================================================
@ -774,19 +985,19 @@ Finance::Quote - Get stock and mutual fund quotes from various exchanges
%quotes = $q->yahoo(@symbols); # NYSE quotes
%quotes = $q->yahoo_europe(@symbols); # Europe quotes
%quotes = $q->fidelity(@symbols); # Fidelity Investments Quotes
%quotes = $q->troweprice(@symbols); # Quotes from T. Rowe Price
%quotes = $q->vanguard(@symbols); # Quotes from Vanguard Group
%quotes = $q->asx(@symbols); # Australian quotes from ASX.
%quotes = $q->troweprice(); # Quotes from T. Rowe Price
%quotes = $q->tiaacref(@symbols); # Annuities from TIAA-CREF
%quotes = $q->asx(@symbols); # Australian quotes from ASX.
%quotes = $q->fetch("asx",@symbols); # Same as above, different syntax.
print ("the last price was ", $quotes{"IBM", "last"} );
=head1 DESCRIPTION
This module gets stock quotes from various internet sources, including
Yahoo! Finance and Fidelity Investments. The functions will return a
quote for each of the stock symbols passed to it. The return value of
each of the routines is a hash, which may include one or more of the
following elements:
Yahoo! Finance, Fidelity Investments, and the Australian Stock Exchange.
The functions will return a quote for each of the stock symbols passed to
it. The return value of each of the routines is a hash, which may include
one or more of the following elements:
name Company or Mutual Fund Name
last Last Price
@ -794,35 +1005,48 @@ following elements:
low Lowest trade today
date Last Trade Date (MM/DD/YY format)
time Last Trade Time
Change
net Net Change
p_change Percent Change from previous day's close
volume Volume
Average Daily Vol
avg_vol Average Daily Vol
bid Bid
ask Ask
close Previous Close
open Today's Open
Day's Range
52-Week Range
day_range Day's Range
year_range 52-Week Range
eps Earnings per Share
pe P/E Ratio
Dividend Pay Date
Dividend per Share
Dividend Yield
div_date Dividend Pay Date
div Dividend per Share
div_yield Dividend Yield
cap Market Capitalization
ex_div Ex-Dividend Date.
nav Net Asset Value
yeild Yeild (usually 30 day avg)
yield Yield (usually 30 day avg)
success Did the stock successfully return information? (true/false)
errormsg If success is false, this field may contain the reason why.
(Elements which are not yet implemented have no key associated
with them. Not all methods return all keys at all times.)
If all stock lookups fail (possibly because of a failed connection) then
`undef' may be returned.
You may optionally override the default LWP timeout of 180 seconds by setting
$quote->timeout() or Finance::Quote::timeout() to your preferred value.
Note that prices from the Australian Stock Exchange (ASX) are in
Australian Dollars. Prices from Yahoo! Europe are in euros. All other
Australian Dollars. Prices from Yahoo! Europe are in Euros. All other
prices are in US Dollars.
=head2 troweprice
The troweprice() function ignores any arguments passed to it. Instead it
returns all funds managed by T.RowePrice.
=head2 tiaacref
For TIAA and CREF Annuities, you must use TIAA-CREF's pseudosymbols. These
are as follows:
@ -838,12 +1062,28 @@ are as follows:
Teachers PA Select Stock: TIAAsele
Growth: CREFgrow
=head2 FETCH
my %stocks = $q->fetch("nasdaq","IBM","MSFT");
A new function, fetch(), provides a more generic and easy-to-use interface
to the library. It takes a source as the first argument, and then a list
of ticker-symbols to obtain from that source. fetch() will understand the
case-insensitive sources "nasdaq", "nyse" and "europe", and map them to
the yahoo or yahoo_europe methods appropriately.
=head1 ENVIRONMENT
Finance::Quote respects all environment that your installed
version of LWP::UserAgent respects. Most importantly, it
respects the http_proxy environment variable.
=head1 FAQ
If there's one question I get asked over and over again, it's how did
I figure out the format string? Having typed the answer in
innumerable emails, I figure sticking it directly into the man page
might help save my fingers a bit...
If there's one question I get asked over and over again, it's how did I
figure out the format string for Yahoo! quotes? Having typed the answer in
innumerable emails, I figure sticking it directly into the man page might
help save my fingers a bit...
If you have a My Yahoo! (http://my.yahoo.com) account, go to the
following URL:
@ -858,9 +1098,22 @@ refers to the string "s" and name refers to the string "l". Using
"sl" as the format string, we would get the symbol followed by the
name of the security.
If you have questions regarding this, play around with $QURL, changing
If you have questions regarding this, play around with $YAHOO_URL, changing
the value of the f parameter.
=head1 BUGS
Not all functions return an errormsg when a failure results.
Not everything checks for errors as well as they could.
There is no way to add extra aliases to the fetch list.
There is no good documentation on which functions return what fields.
This documentation is getting a little long and cumbersome. It should
be broken up into more logical sections.
=head1 COPYRIGHT
Copyright 1998, Dj Padzensky

@ -14,7 +14,7 @@ update_prices is a stand-alone perl script for updating the prices
Finance::Quote
This is a perl 5 module that will pull one or more stock and/or mutual
fund quotes from a variety of sources, including Yahoo! Finance.
Now maintained in SourceForge by Paul Fenwick (<pjf@schools.net.au>)
Now maintained in SourceForge by Paul Fenwick (<pjf@cpan.org>)
http://sourceforge.net/project/?group_id=4232

@ -6,6 +6,9 @@ use Quote;
## Simple program to get quotes and feed them back to gnucash.
## Modified by Paul Fenwick <pjf@cpan.org>, June 2000, to take
## advantage of new Finance::Quote features.
## Input (on standard input - one line per entry)
##
## ("IBM" "YAHOO")
@ -43,15 +46,6 @@ use Quote;
my $exit_status = 0;
my %quote_source_data =
("YAHOO" => [\&Quote::yahoo, "last"],
"YAHOO_EUROPE" => [\&Quote::yahoo_europe, "last"],
"FIDELITY" => [\&Quote::fidelity, "nav"],
"TRPRICE" => [\&Quote::troweprice, "nav"],
"VANGUARD" => [\&Quote::vanguard, "nav"],
"ASX" => [\&Quote::asx, "last"],
"TIAACREF" => [\&Quote::tiaacref, "nav"]);
sub schemify_str {
my($str) = @_;
@ -98,22 +92,9 @@ while(<>) {
next;
}
my $quote_source_data = $quote_source_data{$quote_source_name};
if(!$quote_source_data) {
# We don't have to schemify the source - the regexp filtered it.
print "(error bad-quote-source ";
print "\"Ignoring input line with bad source: $quote_source_name.\")\n";
$exit_status |= 1;
next;
}
my $quote_func = $$quote_source_data[0];
my $quote_hash_label = $$quote_source_data[1];
my %quote_data = &$quote_func($security_name);
my %quote_data = &Quote::fetch($quote_source_name,$security_name);
if(!%quote_data) {
unless($quote_data{$quote_source_name,'success'}) {
# We don't have to schemify the source or name - the regexp filtered it.
print "(error quote-lookup-failed ";
print "\"Lookup of $security_name at $quote_source_name failed.\")\n";
@ -121,7 +102,7 @@ while(<>) {
next;
}
my $security_price = $quote_data{$security_name, $quote_hash_label};
my $security_price = $quote_data{$security_name, 'price'};
my $quote_date = $quote_data{$security_name, 'date'};
if(!$security_price) {

@ -9,6 +9,9 @@
#
# HISTORY:
# Created by Linas Vepstas January 1999
# Updated by Paul Fenwick <pjf@cpan.org> to take advantage of
# new Finance::Quote features. (June 2000)
#
# Copyright (c) 1999-2000 Linas Vepstas
use lib '@-GNC_PERLSHAREDIR-@';
@ -160,47 +163,16 @@ foreach $acct (@acctlist)
undef $price; # undef to make sure later if($price) not broken
if ("YAHOO" eq $quotesrc)
{
%quotes = &Quote::yahoo ($security);
$price = $quotes {$security, "last"};
}
elsif ("YAHOO_EUROPE" eq $quotesrc)
{
%quotes = &Quote::yahoo_europe ($security);
$price = $quotes {$security, "last"};
}
elsif ("FIDELITY" eq $quotesrc)
{
%quotes = &Quote::fidelity ($security);
$price = $quotes {$security, "nav"};
}
elsif ("TRPRICE" eq $quotesrc)
{
%quotes = &Quote::troweprice ($security);
$price = $quotes {$security, "nav"};
}
elsif ("VANGUARD" eq $quotesrc)
{
%quotes = &Quote::vanguard ($security);
$price = $quotes {$security, "nav"};
}
elsif ("ASX" eq $quotesrc)
{
%quotes = &Quote::asx ($security);
$price = $quotes {$security, "last"};
}
elsif ("TIAACREF" eq $quotesrc)
{
%quotes = &Quote::tiaacref ($security);
$price = $quotes {$security, "nav"};
}
else
%quotes = &Quote::fetch($quotesrc, $security);
unless ($quotes{$security,'success'})
{
print "unknown quote source: $quotesrc\n";
print "Lookup of $quotesrc/$security failed: ",
$quotes{$security,'errormsg'}."\n";
next;
}
$price = $quotes{$security,'price'};
print "using $quotesrc\n";
print "$name: ";

Loading…
Cancel
Save