Finance-Quote/lib/Finance/Quote/YahooWeb.pm
# vi: set noai ic ts=4 sw=4 showmode showmatch:
# 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 3 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, see <http://www.gnu.org/licenses/>.
package Finance::Quote::YahooWeb;
use warnings;
use strict;
use Encode qw( encode_utf8 );
use HTTP::Request::Common;
use HTML::TreeBuilder::XPath;
use JSON qw( decode_json );
use LWP::Protocol::http;
use Text::Template;
use HTTP::Cookies;
use URI::Escape;
use constant DEBUG => $ENV{DEBUG};
use if DEBUG, 'Smart::Comments';
use constant URLTAG => "data-url";
use constant JSONBODY => "body";
our $VERSION = '1.67_01'; # TRIAL VERSION
# Fix for 500 Header line too long message
push(@LWP::Protocol::http::EXTRA_SOCK_OPTS, MaxLineLength => 0);
my $URL = Text::Template->new(TYPE => 'STRING', SOURCE => 'https://finance.yahoo.com/quote/{$symbol}/history?p={$symbol}&crumb={$crumb}');
# my $AGENT = 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_10_1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/39.0.2171.95 Safari/537.36';
my $AGENT = 'Mozilla/5.0';
my $XPATH = Text::Template->new(TYPE => 'STRING', SOURCE => '//*[@data-symbol=~"^{$symbol}$"][@data-field=~"regularMarketPrice"]');
our $DISPLAY = '<Module Name + Brief Info>';
our @LABELS = qw/symbol name exchange currency isodate last open high low volume/;
our $METHODHASH = {subroutine => \&yahooweb,
display => $DISPLAY,
labels => \@LABELS};
sub methodinfo {
return (
yahooweb => $METHODHASH,
);
}
sub labels {
my %m = methodinfo();
return map {$_ => [@{$m{$_}{labels}}] } keys %m;
}
sub methods {
my %m = methodinfo(); return map {$_ => $m{$_}{subroutine} } keys %m;
}
sub yahooweb {
my $quoter = shift;
my @stocks = @_;
my ( %info, $url, $reply, $script_tag );
my $ua = $quoter->user_agent();
my $agent = $ua->agent();
my $cookie_jar = HTTP::Cookies->new;
# Redirect handler deals with cookie consent workflow applicable to EU countries
# credit to John Weber from Germany for injecting redirect handler
my $gcrumb = "";
$ua->add_handler("response_redirect", sub {
my($response, $ua, $h) = @_;
# Check where we've been redirected and act accordingly
my $redirect_uri = URI->new($response->header("Location"));
if ($redirect_uri->path eq "/consent") {
# Remember gcrumb value for collectConsent request later
my %params = $redirect_uri->query_form;
$gcrumb = $params{'gcrumb'};
} elsif ($redirect_uri->path eq "/v2/collectConsent") {
my %params = $redirect_uri->query_form;
my $sessionId = $params{'sessionId'};
# Turn this request into a POST with form data to confoo accept cookies
my $request = POST($redirect_uri, [
'csrfToken' => $gcrumb,
'sessionId' => $sessionId,
'originalDoneUrl' => 'https://www.yahoo.com/?guccounter=1',
'namespace' => 'yahoo',
# For the EU consent, either can :
# 'agree' => 'agree'
# to it or
'reject' => 'reject'
]);
return $request;
}
return;
});
$ua->cookie_jar($cookie_jar);
$ua->agent($AGENT);
# Tell user agent to redirect POSTs in additional to GET AND HEAD
$ua->requests_redirectable(['GET', 'HEAD', 'POST']);
# get necessary cookies
$reply = $ua->get('https://www.yahoo.com/', "Accept" => "text/html");
if ($reply->code != 200) {
foreach my $symbol (@stocks) {
$info{$symbol, "success"} = 0;
$info{$symbol, "errormsg"} = "Error accessing www.yahoo.com: $@";
}
return wantarray() ? %info : \%info;
}
# get the crumb that corrosponds to cookies retrieved
$reply = $ua->request(GET 'https://query2.finance.yahoo.com/v1/test/getcrumb');
if ($reply->code != 200) {
foreach my $symbol (@stocks) {
$info{$symbol, "success"} = 0;
$info{$symbol, "errormsg"} = "Error accessing queary.finance.yahoo.com/v1/test/getcrumb: $@";
}
return wantarray() ? %info : \%info;
}
my $crumb = uri_escape($reply->content);
### [<now>] cookie_jar : $cookie_jar
### [<now>] crumb : $crumb
foreach my $symbol (@stocks) {
$url = $URL->fill_in(HASH => {symbol => $symbol, crumb => $crumb});
### [<now>] YahooWeb: $url
$reply = $ua->request(GET $url);
### [<now>] Reply: $reply
unless ($reply->is_success) {
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = join ' ', $reply->code, $reply->message;
next;
}
my $tree = HTML::TreeBuilder::XPath->new();
$tree->ignore_unknown(0);
$tree->parse($reply->decoded_content);
$script_tag = $tree->look_down(_tag => 'script', type => 'application/json', URLTAG, qr!https://query1.finance.yahoo.com/v7/finance/quote\?fields=fiftyTwoWeekHigh.*! );
### [<now>] script_tag: $script_tag
unless($script_tag) {
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = 'Error - Symbol not found';
next;
}
my @numfound = $script_tag->content_list();
### [<now>] numfound: @numfound
my $json_data;
eval {$json_data = decode_json encode_utf8( $numfound[0] )};
if($@) {
$info{ $symbol, 'success' } = 0;
$info{ $symbol, 'errormsg' } = $@;
next;
}
### [<now>] json_data: $json_data
my $json_body =
encode_utf8($json_data->{'body'});
### [<now>] json_body: $json_body;
eval {$json_data = decode_json $json_body};
if($@) {
$info{ $symbol, 'success' } = 0;
$info{ $symbol, 'errormsg' } = $@;
next;
}
### [<now>] json_data 2: $json_data
my $yahoo_symbol =
$json_data->{'quoteResponse'}{'result'}[0]{'symbol'};
my $name = $json_data->{'quoteResponse'}{'result'}[0]{'shortName'};
if (uc($symbol) ne uc($yahoo_symbol)) {
### Error: $symbol, $yahoo_symbol
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = 'Unexpected response from Yahoo site';
next;
}
$info{ $symbol, 'name' } = $name if $name;
my $currency = $json_data->{'quoteResponse'}{'result'}[0]{'currency'};
$info{ $symbol, 'currency' } = $currency if $currency;
$info{ $symbol, 'exchange' } =
$json_data->{'quoteResponse'}{'result'}[0]{'fullExchangeName'};
if ($currency =~ /^GBp/) {
$info{ $symbol, 'currency' } = 'GBP';
} else {
$info{ $symbol, 'currency' } = $currency;
}
my $last = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketPrice'}{'fmt'};
$last =~ s/,//g;
if ($currency =~ /^GBp/) {
$last = $last / 100;
}
my $open = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketOpen'}{'fmt'};
if ($open) {
$open =~ s/,//g;
if ($currency =~ /^GBp/) {
$open = $open / 100;
}
}
my $high = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketDayHigh'}{'fmt'};
if ($high) {
$high =~ s/,//g;
if ($currency =~ /^GBp/) {
$high = $high / 100;
}
}
my $low = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketDayLow'}{'fmt'};
if ($low) {
$low =~ s/,//g;
if ($currency =~ /^GBp/) {
$low = $low / 100;
}
}
my $volume = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketVolume'}{'raw'};
$volume =~ s/,//g if $volume;
# regularMarketTime in JSON is seconds since epoch
my $tradedate = $json_data->{'quoteResponse'}{'result'}[0]{'regularMarketTime'}{'raw'};
my (undef,undef,undef,$day,$month,$year,undef,undef,undef) = localtime($tradedate);
$month += 1;
$year += 1900;
### YahooWeb Result: $last
$info{ $symbol, 'last'} = $last;
$info{ $symbol, 'open'} = $open;
$info{ $symbol, 'high'} = $high;
$info{ $symbol, 'low'} = $low;
$info{ $symbol, 'volume'} = $volume unless $volume eq "-";
$quoter->store_date(\%info, $symbol, {month => $month, day => $day, year => $year});
$info{ $symbol, 'symbol' } = $symbol;
$info{ $symbol, 'method' } = 'yahooweb';
$info{ $symbol, 'success' } = 1;
}
$ua->agent($agent);
return wantarray ? %info : \%info;
}
1;
=head1 NAME
Finance::Quote::YahooWeb - Obtain quotes from https://finance.yahoo.com/quote
=head1 SYNOPSIS
use Finance::Quote;
$q = Finance::Quote->new('YahooWeb');
%info = $q->fetch('yahooweb', "IBM", "AAPL");
=head1 DESCRIPTION
This module fetches information from https://finance.yahoo.com/quote.
This module is loaded by default on a Finance::Quote object. It's
also possible to load it explicitly by placing "YahooWeb" in the argument
list to Finance::Quote->new().
This module provides the "yahooweb" fetch method.
=head1 LABELS RETURNED
The following labels may be returned by Finance::Quote::YahooWeb :
symbol name exchange currency isodate last open high low volume
=cut