|
|
|
|
@ -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
|
|
|
|
|
|