File Coverage

blib/lib/Finance/Quote/GoogleWeb.pm
Criterion Covered Total %
statement 23 86 26.7
branch 0 18 0.0
condition n/a
subroutine 9 10 90.0
pod 0 3 0.0
total 32 117 27.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # vi: set ts=2 sw=2 noai ic showmode showmatch:
3             #
4             # Copyright (C) 2023, Bruce Schuck <bschuck@asgard-systems.com>
5             #
6             # This program is free software; you can redistribute it and/or modify
7             # it under the terms of the GNU General Public License as published by
8             # the Free Software Foundation; either version 2 of the License, or
9             # (at your option) any later version.
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program; if not, write to the Free Software
18             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
19             # 02110-1301, USA
20             #
21              
22             package Finance::Quote::GoogleWeb;
23              
24 5     5   2630 use strict;
  5         14  
  5         153  
25 5     5   26 use warnings;
  5         15  
  5         141  
26              
27 5     5   27 use Encode qw(decode);
  5         9  
  5         224  
28 5     5   31 use HTML::TreeBuilder;
  5         14  
  5         36  
29 5     5   160 use HTTP::Request::Common;
  5         21  
  5         373  
30              
31 5     5   38 use constant DEBUG => $ENV{DEBUG};
  5         13  
  5         374  
32 5     5   35 use if DEBUG, 'Smart::Comments', '###';
  5         11  
  5         42  
33              
34             our $VERSION = '1.58'; # VERSION
35              
36             my $GOOGLE_URL = 'https://www.google.com/finance/';
37              
38             sub methods {
39 5     5 0 32 return (googleweb => \&googleweb,
40             nyse => \&googleweb,
41             nasdaq => \&googleweb);
42             }
43              
44             our @labels = qw/symbol name last date currency method/;
45              
46             sub labels {
47 5     5 0 18 return (googleweb => \@labels,
48             nyse => \@labels,
49             nasdaq => \@labels);
50             }
51              
52             sub googleweb {
53              
54 0     0 0   my $quoter = shift;
55 0           my @stocks = @_;
56 0           my (%info, $tree, $url, $reply);
57 0           my $ua = $quoter->user_agent();
58              
59 0           foreach my $stock (@stocks) {
60              
61 0           my $ucstock = uc($stock);
62 0           $url = $GOOGLE_URL . "quote/" . $ucstock;
63 0           $reply = $ua->request( GET $url);
64              
65 0           my $code = $reply->code;
66 0           my $desc = HTTP::Status::status_message($code);
67 0           my $headers = $reply->headers_as_string;
68 0           my $body = decode('UTF-8', $reply->content);
69              
70             ### Body: $body
71              
72 0           my ($name, $last, $date, $currency, $time, $taglink, $link, $exchange);
73              
74 0           $info{ $stock, "symbol" } = $stock;
75              
76 0 0         if ( $code == 200 ) {
77              
78             # Use HTML::TreeBuilder to parse HTML in $body
79             # Without the exchange Google returns a list of possible matches
80             # For example AAPL will give you a list of links that will
81             # include AAPL:NASDAQ
82 0           $tree = HTML::TreeBuilder->new;
83 0 0         if ($tree->parse_content($body)) {
84             #
85             # Get link with exchange appended (NYSE|NASDAQ|NYSEAMERICAN)
86 0           $taglink = $tree->look_down(_tag => 'a', href => qr!^./quote/$ucstock:(NYSE|NASDAQ|NYSEAMERICAN)!);
87 0 0         if ($taglink) {
88 0           $link = $taglink->attr('href');
89 0           $link =~ s|\./quote|quote|;
90 0           ($exchange = $link) =~ s/.*${ucstock}://;
91             } else {
92 0           $info{ $stock, "success" } = 0;
93 0           $info{ $stock, "errormsg" } = "$stock not found on Google Finance";
94 0           next;
95             }
96             } else { # Could not parse body into tree
97 0           $info{ $stock, "success" } = 0;
98 0           $info{ $stock, "errormsg" } =
99             "Error retrieving quote for $stock. Could not parse HTML returned from $url.";
100 0           next;
101             }
102              
103             # Found a link that looks like STOCK:EXCHANGE
104             # Fetch that link and parse
105 0           $url = $GOOGLE_URL . $link;
106              
107 0           $reply = $ua->get($url);
108              
109 0 0         if ($reply->code ne "200") {
110 0           $info{ $stock, "success" } = 0;
111 0           $info{ $stock, "errormsg" } =
112             "Error retrieving quote for $stock from $url";
113 0           next;
114             }
115            
116             # Parse returned HTML
117 0           $body = decode('UTF-8', $reply->content);
118 0 0         unless ($tree->parse_content($body)) {
119 0           $info{ $stock, "success" } = 0;
120 0           $info{ $stock, "errormsg" } =
121             "Cannot parse HTML from $url";
122 0           next;
123             }
124              
125             # Look for div tag with data-last-price attribute
126             $taglink =
127 0           $tree->look_down(_tag => 'div', 'data-last-price' => qr|[0-9.]+|);
128 0 0         unless ($taglink) {
129 0           $info{ $stock, "success" } = 0;
130 0           $info{ $stock, "errormsg" } = "Cannot find price data in $url";
131 0           next;
132             }
133              
134 0           $last = $taglink->attr('data-last-price');
135             # Google does not include .00 if the price is a whole dollar amount
136 0 0         unless ( $last =~ /\./ ) {
137 0           $last = $last . '.00';
138             }
139             # Also fix missing cents (15.30 will be 15.3 in the HTML)
140 0 0         if ( $last =~ /\d+\.\d$/ ) {
141 0           $last = $last . '0';
142             }
143              
144 0           $time = $taglink->attr('data-last-normal-market-timestamp');
145 0           $currency = $taglink->attr('data-currency-code');
146 0           my ( undef, undef, undef, $mday, $mon, $year, undef, undef, undef ) =
147             localtime($time);
148 0           $date = sprintf("%d/%02d/%02d", $year + 1900, $mon + 1, $mday);
149              
150 0           $info{ $stock, 'method' } = 'googleweb';
151 0           $info{ $stock, 'last' } = $last;
152 0           $info{ $stock, 'currency' } = $currency;
153 0           $info{ $stock, 'exchange' } = $exchange;
154 0           $quoter->store_date(\%info, $stock, { isodate => $date});
155 0           $info{ $stock, 'success' } = 1;
156              
157             } else { # HTTP Request failed (code != 200)
158 0           $info{ $stock, "success" } = 0;
159 0           $info{ $stock, "errormsg" } =
160             "Error retrieving quote for $stock. Attempt to fetch the URL $url resulted in HTTP response $code ($desc)";
161             }
162              
163             }
164              
165 0 0         return wantarray() ? %info : \%info;
166 0           return \%info;
167              
168             }
169              
170             1;
171              
172             __END__
173              
174             =head1 NAME
175              
176             Finance::Quote::GoogleWeb - Obtain quotes from Google Finance Web Pages
177              
178             =head1 SYNOPSIS
179              
180             use Finance::Quote;
181              
182             $q = Finance::Quote->new;
183              
184             %info = $q->fetch("googleweb", "aapl"); # Only query googleweb
185              
186             %info = $q->fetch("nyse", "ge"); # Failover to other sources OK.
187              
188             =head1 DESCRIPTION
189              
190             This module fetches information from L<https://www.google.com/finance/>.
191              
192             This module is loaded by default on a Finance::Quote object. It's also possible
193             to load it explicitly by placing "googleweb" in the argument list to
194             Finance::Quote->new().
195              
196             This module provides "googleweb", "nyse", and "nasdaq"
197             fetch methods.
198              
199             =head1 LABELS RETURNED
200              
201             The following labels are returned:
202              
203             =over
204              
205             =item name
206              
207             =item symbol
208              
209             =item last
210              
211             =item date
212              
213             =item currency
214              
215             =item method
216              
217             =back
218              
219             =head1 AVAILABLE EXCHANGES
220              
221             While the Google Finance web pages contain price information from other
222             stock exchanges, this module currently retrieves last trade prices for
223             securities listed on the NYSE, American, and NASDAQ stock exchanges.