| Subject: | FinanceCanada.pm module |
The FinanceCanada module was broken since canada.finance.com changed its
website for financial information. The new module now uses
www.financialpost.com, and can retrieve quotes for both stocks and
mutual funds.
The module can retrieve information from multiple exchanges (TOR, NYSE,
etc.) and because symbols are not unique among different exchanges, it
is worthwhile to check the stock symbol / ID on the financialpost.com
site before using the module to ensure correct information is retrieved.
Attached is the updated F::Q module and a testing module.
| Subject: | FinanceCanada.pm |
#!/usr/bin/perl -w
#
# FinanceCanada.pm
#
# Version 0.1 Initial version
#
# Version 0.2 Rewrite by David Hampton <hampton@employees.org> for
# changed web site.
#
# Version 0.3 Rewrite by linux_slacker <paul.polak[AT]gmail[DOT]com> for
# changed web site
package Finance::Quote::FinanceCanada;
require 5.004;
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTML::TokeParser::Simple;
my $VERSION = '0.3';
my $FINANCECANADA_MAINURL = ("http://www.financialpost.com/");
my $FINANCECANADA_STOCKSYM_URL = "http://idms.financialpost.com/stocks/company_overview.idms?SYMBOL=";
my $FINANCECANADA_STOCKID_URL = "http://idms.financialpost.com/stocks/company_overview.idms?ID_NOTATION=";
my $FINANCECANADA_FUND_URL = "http://idms.financialpost.com/funds/snapshot.idms?FUND_KEY=";
sub methods {
return (canada => \&financecanada,
financecanada => \&financecanada);
}
sub labels {
my @labels = qw/method source name symbol currency last date isodate nav price/;
return (canada => \@labels,
financecanada => \@labels);
}
sub financecanada {
my $quoter = shift;
my @symbols = @_;
my %info;
return unless @symbols;
my $ua = $quoter->user_agent;
foreach my $symbol (@symbols) {
$info{$symbol, "success"} = 0;
$info{$symbol, "symbol"} = $symbol;
$info{$symbol, "method"} = "financecanada";
$info{$symbol, "source"} = $FINANCECANADA_MAINURL;
my @sites;
# Figure out which URLs we should use
if ($symbol =~ /^[A-Za-z]/) {
@sites = ($FINANCECANADA_STOCKSYM_URL);
}
else {
@sites = ($symbol =~ /^\d{5}$/)
? ($FINANCECANADA_FUND_URL, $FINANCECANADA_STOCKID_URL)
: ($FINANCECANADA_STOCKID_URL, $FINANCECANADA_FUND_URL);
}
foreach my $root (@sites) {
my $url = $root.$symbol;
my $response = $ua->request(GET $url);
if (!$response->is_success) {
$info{$symbol, "errormsg"} = "Error contacting URL";
next;
}
my $parser = HTML::TokeParser::Simple->new(string => $response->content);
my %ret = ($root eq $FINANCECANADA_FUND_URL)
? ParseFund(\$parser) : ParseStock(\$parser);
for my $key (keys %ret) {
$info{$symbol, $key} = $ret{$key};
}
last if ($info{$symbol, "success"});
}
if ($info{$symbol, "success"} == 1) {
if (!defined($info{$symbol, "currency"})) {
$info{$symbol, "currency"} = "CAD";
}
# Use current day at GMT time, since no date given with quote
my ($day, $month, $year) = getGMTDate();
$quoter->store_date(\%info, $symbol,
{month => $month, day => $day, year => $year});
$info{$symbol, "timezone"} = "GMT";
foreach (keys %info) {
$info{$_} =~ s/\$//;
}
if (defined($info{$symbol, "high"}) && defined($info{$symbol, "low"})) {
$info{$symbol, "day_range"} = $info{$symbol, "low"} . " - " . $info{$symbol, "high"};
}
if (defined($info{$symbol, "year_high"}) && defined($info{$symbol, "year_low"})) {
$info{$symbol, "year_range"} = $info{$symbol, "year_low"}." - ".$info{$symbol, "year_high"};
}
}
else {
$info{$symbol, "errormsg"} = "Cannot parse quote data";
}
}
return wantarray() ? %info : \%info;
}
sub ParseStock($) {
my $ref = shift;
my $parser = $$ref;
my %info;
while (my $div = $parser->get_tag('div')) {
my $id = $div->get_attr('id');
if ($id eq "IDMScontainer") {
my $header = $parser->get_tag('h2');
my $name = trim($parser->get_trimmed_text('/h2'));
$name =~ s/ //g;
# Should have at least 1 alphabetic character...
last unless ($name =~ /[A-Za-z]/);
$info{"name"} = $name;
}
elsif ($id eq "fundProfile") {
for (my $i=0; $i<6; $i++) {
my $span = $parser->get_tag('span');
my $class = $span->get_attr('class');
if ($class eq "price") {
my $price = removedollar($parser->get_trimmed_text('/span'));
last unless ($price =~ /^\d/);
$info{"price"} = $price;
$info{"success"} = 1;
}
elsif (($class eq "positive") || ($class eq "negative")) {
my $raw = $parser->get_trimmed_text('/span');
$raw =~ /^(\-)?\$((\d)+(\.\d\d))/;
$info{"net"} = $1.$2;
}
elsif ($class eq "high") {
$info{"high"} = removedollar($parser->get_trimmed_text('/span'));
}
elsif ($class eq "low") {
$info{"low"} = removedollar($parser->get_trimmed_text('/span'));
}
elsif ($class eq "volume") {
$info{"volume"} = $parser->get_trimmed_text('/span');
}
}
}
elsif ($id eq "quoteDetail") {
for (my $i=0; $i<18; $i++) {
my $th = $parser->get_tag('th');
if ($i == 3) {
$info{"year_high"} = removedollar($parser->get_trimmed_text('th'));
}
elsif ($i == 5) {
$info{"cap"} = removedollar($parser->get_trimmed_text('th'));
}
elsif ($i == 9) {
$info{"year_low"} = removedollar($parser->get_trimmed_text('th'));
}
elsif ($i == 15) {
$info{"exchange"} = $parser->get_trimmed_text('th');
}
}
}
}
return %info;
}
sub ParseFund($) {
my $ref = shift;
my $parser = $$ref;
my %info;
my $idmscount = 0;
while (my $div = $parser->get_tag('div')) {
my $id = $div->get_attr('id');
if ($id eq "IDMScontainer") {
$idmscount++;
if ($idmscount == 1) {
my $header = $parser->get_tag('h2');
my $name = trim($parser->get_trimmed_text('/h2'));
$name =~ s/ //g;
# Should have at least 1 alphabetic character...
last unless ($name =~ /[A-Za-z]/);
$info{"name"} = $name;
}
else {
while (my $tr = $parser->get_tag('tr')) {
my $tdcount = 0;
while (my $td = $parser->get_tag('td')) {
$tdcount++;
if ($tdcount == 1) {
my $price = removedollar($parser->get_trimmed_text('/td'));
last unless ($price =~ /^\d/);
$info{"nav"} = $price;
$info{"success"} = 1;
}
elsif ($tdcount == 2) {
$info{"net"} =
removedollar($parser->get_trimmed_text('/span'));
}
elsif ($tdcount == 7) {
$info{"currency"} =
$parser->get_trimmed_text('/td');
}
}
}
}
}
}
return %info;
}
sub getGMTDate() {
my @timeData = gmtime(time);
my $day = $timeData[3];
my $month = 1 + $timeData[4];
my $year = 1900 + $timeData[5];
return ($day, $month, $year);
}
sub trim($) {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub removedollar($) {
my $raw = shift;
$raw =~ /^\$?(.*)$/;
return $1;
}
1;
=head1 NAME
Finance::Quote::FinanceCanada - Obtain stock and fund prices
from www.financialpost.com
=head1 SYNOPSIS
use Finance::Quote;
$q = Finance::Quote->new;
# Can failover to other methods
%quotes = $q->fetch("canada", "stock_code");
# Use this module only
%quotes = $q->fetch("financecanada", "stock_code");
=head1 DESCRIPTION
This module obtains information about Canadian stocks and funds from
www.financialpost.com. The information source "canada" can be used if the
information source is unimportant, or "financecanada" to specifically use
www.financialpost.com.
=head1 STOCK_CODE
Canadian stocks/mutual funds do not have a unique symbol identifier on
www.financialpost.com. For example, the symbol "T" can refer to stock
quotes from either "Telus" on the Toronto Stock Exchange (TOR) or
"AT&T Inc." on NYSE. The simplest way to fetch the ID for a particular
stock/fund is to go to www.financialpost.com, search for your
particular stock/fund, and note the symbol 'id' in the site URL.
Note that www.financialpost.com uses different URLs for stocks and funds.
This module attempts to guess which URL to use based regular expressions tests
on the symbol.
=head1 LABELS RETURNED
Information available from financecanada may include the following labels:
method source name symbol currency date nav last price
=head1 SEE ALSO
Finance Canada.com website - http://www.financialpost.com/
Finance::Quote
=cut
| Subject: | FinanceCanada.t |
#!/usr/bin/perl
use strict;
use Test;
use Data::Dumper;
BEGIN {plan tests => 22};
use Finance::Quote;
# Test FinanceCanada functions
my $q = Finance::Quote->new();
my @stocks = ("RY", "T", "15213", "283808");
my %regexps = (
RY => qr/\bROYAL\b/,
T => qr/\bAT\&T\b/,
15213 => qr/\bTD Canadian Index\b/,
283808 => qr/\bSPRINT\b/,
);
my %quotes = $q->fetch("financecanada", @stocks);
ok(%quotes);
foreach my $stock (@stocks) {
my $name = $quotes{$stock, "name"};
print "#Testing $stock: $name\n";
my $regexp = $regexps{$stock};
ok($name =~ /$regexp/i);
ok($quotes{$stock, "method"} eq 'financecanada');
ok(($quotes{$stock, "price"} > 0) || ($quotes{$stock, "nav"} > 0));
ok($quotes{$stock, "net"} =~ /^-?\d+\.\d+$/);
ok($quotes{$stock, "success"});
}
# Check that a bogus stock returns no-success.
%quotes = $q->fetch("financecanada", "BOGUS");
ok(! $quotes{"BOGUS", "success"});