diff --git a/src/quotes/Quote.pm b/src/quotes/Quote.pm index dc03db9023..dce54f2e90 100644 --- a/src/quotes/Quote.pm +++ b/src/quotes/Quote.pm @@ -4,7 +4,7 @@ # Copyright (C) 1998, 1999 Linas Vepstas # Copyright (C) 2000, Yannick LE NY # Copyright (C) 2000, Paul Fenwick -# Copyright (C) 2000, Brent Neal +# Copyright (C) 2000, Brent Neal # # 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 +# +# +# ========================================================================== +# +# 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=X1\d\d?:\d\d\w\w(\d+\.\d+)#; + + 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 diff --git a/src/quotes/README b/src/quotes/README index c3b7a4c91d..d94a5712b4 100644 --- a/src/quotes/README +++ b/src/quotes/README @@ -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 () + Now maintained in SourceForge by Paul Fenwick () http://sourceforge.net/project/?group_id=4232 diff --git a/src/quotes/gnc-prices-2.in b/src/quotes/gnc-prices-2.in index 08683eb017..9d39fe82a2 100644 --- a/src/quotes/gnc-prices-2.in +++ b/src/quotes/gnc-prices-2.in @@ -6,6 +6,9 @@ use Quote; ## Simple program to get quotes and feed them back to gnucash. +## Modified by Paul Fenwick , 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) { diff --git a/src/quotes/gnc-prices.in b/src/quotes/gnc-prices.in index 382e09990d..83e48d5a2b 100644 --- a/src/quotes/gnc-prices.in +++ b/src/quotes/gnc-prices.in @@ -9,6 +9,9 @@ # # HISTORY: # Created by Linas Vepstas January 1999 +# Updated by Paul Fenwick 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: ";