File Coverage

blib/lib/Finance/Quote/Fool.pm
Criterion Covered Total %
statement 26 67 38.8
branch 0 20 0.0
condition n/a
subroutine 10 11 90.9
pod 0 3 0.0
total 36 101 35.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # vi: set noai ts=2 sw=2 ic showmode showmatch:
3             # This module was rewritten in June 2019 based on the
4             # Finance::Quote::IEXCloud.pm module and prior versions of Fool.pm
5             # that carried the following copyrights:
6             #
7             # Copyright (C) 1998, Dj Padzensky <djpadz@padz.net>
8             # Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
9             # Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
10             # Copyright (C) 2000, Paul Fenwick <pjf@cpan.org>
11             # Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
12             # Copyright (C) 2001, Tobias Vancura <tvancura@altavista.net>
13             #
14             # This program is free software; you can redistribute it and/or modify
15             # it under the terms of the GNU General Public License as published by
16             # the Free Software Foundation; either version 2 of the License, or
17             # (at your option) any later version.
18             #
19             # This program is distributed in the hope that it will be useful,
20             # but WITHOUT ANY WARRANTY; without even the implied warranty of
21             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22             # GNU General Public License for more details.
23             #
24             # You should have received a copy of the GNU General Public License
25             # along with this program; if not, write to the Free Software
26             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27             # 02110-1301, USA
28              
29             package Finance::Quote::Fool;
30              
31 5     5   2585 use strict;
  5         13  
  5         158  
32 5     5   31 use HTTP::Request::Common;
  5         11  
  5         289  
33 5     5   30 use HTML::TableExtract;
  5         12  
  5         35  
34 5     5   168 use HTML::TreeBuilder;
  5         13  
  5         45  
35 5     5   3736 use Text::Template;
  5         18940  
  5         234  
36 5     5   39 use Encode qw(decode);
  5         17  
  5         245  
37              
38 5     5   30 use constant DEBUG => $ENV{DEBUG};
  5         12  
  5         313  
39 5     5   31 use if DEBUG, 'Smart::Comments';
  5         16  
  5         34  
40              
41             our $VERSION = '1.57_03'; # TRIAL VERSION
42              
43             my $URL = Text::Template->new(TYPE => 'STRING', SOURCE => 'https://caps.fool.com/Ticker/{$symbol}.aspx');
44              
45             sub methods {
46 5     5 0 30 return ( fool => \&fool,
47             usa => \&fool,
48             nasdaq => \&fool,
49             nyse => \&fool);
50             }
51              
52             my @labels = qw/date isodate open high low close volume last/;
53             sub labels {
54 5     5 0 17 return ( iexcloud => \@labels, );
55             }
56              
57             sub fool {
58 0     0 0   my $quoter = shift;
59 0           my @stocks = @_;
60            
61 0           my (%info, $symbol, $url, $reply, $code, $desc, $body);
62 0           my $ua = $quoter->user_agent();
63 0           $ua->agent('Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36');
64            
65 0           my $quantity = @stocks;
66              
67             ### Stocks: @stocks
68              
69 0           foreach my $symbol (@stocks) {
70             # Get the web page
71 0           $url = $URL->fill_in(HASH => {symbol => $symbol});
72             ### url: $url
73 0           $reply = $ua->request( GET $url);
74 0           $code = $reply->code;
75 0           $desc = HTTP::Status::status_message($code);
76 0           $body = decode('UTF-8', $reply->content);
77              
78             ### Reply: $reply
79            
80 0 0         if ($code != 200) {
81 0           $info{ $symbol, 'success' } = 0;
82 0           $info{ $symbol, 'errormsg' } = $desc;
83 0           next;
84             }
85              
86             ### Body: $body
87              
88             # Parse the web page
89 0           my $root = HTML::TreeBuilder->new_from_content($body);
90 0           my $timestamp = $root->look_down(_tag => 'p', class => 'timestamp')->as_text;
91            
92 0           my $te = HTML::TableExtract->new();
93 0           $te->parse($body);
94 0           my $ts = $te->first_table_found();
95 0           my %data;
96            
97 0           foreach my $row ($ts->rows) {
98 0           my %slice = @$row;
99 0           %data = (%data, %slice);
100             }
101            
102             # Assign the results
103             eval {
104 0           $info{$symbol, 'symbol'} = $symbol;
105 0           $info{$symbol, 'method'} = 'fool';
106 0 0         $info{$symbol, 'day_range'} = $data{'Daily Range'} =~ s/[\$,]//g ? $data{'Daily Range'} : die('failed to parse daily range');
107 0 0         $info{$symbol, 'open'} = $data{'Open'} =~ s/[\$,]//g ? $data{'Open'} : die('failed to parse open');
108 0 0         $info{$symbol, 'volume'} = $data{'Volume'} =~ m/[0-9,]+/ ? $data{'Volume'} =~ s/,//gr : die('failed to parse volume');
109 0 0         $info{$symbol, 'close'} = $data{'Prev. Close'} =~ s/[\$,]//g ? $data{'Prev. Close'} : die('failed to parse previous close');
110 0 0         $info{$symbol, 'year_range'} = $data{'52-Wk Range'} =~ s/[\$,]//g ? $data{'52-Wk Range'} : die('failed to parse year range');
111 0 0         $info{$symbol, 'last'} = $data{'Current Price'} =~ s/[\$,]//g ? $data{'Current Price'} : die('failed to parse last price');
112 0           $info{$symbol, 'currency'} = 'USD';
113 0           $info{$symbol, 'currency_set_by_fq'} = 1;
114 0           $info{$symbol, 'success'} = 1;
115            
116             # 03:38 PM EDT on 06/19/19
117 0 0         $quoter->store_date( \%info, $symbol, { usdate => $1 } ) if $timestamp =~ m|([0-9]{2}/[0-9]{2}/[0-9]{2})|;
118             }
119 0 0         or do {
120 0           $info{$symbol, 'errormsg'} = $@;
121 0           $info{$symbol, 'success'} = 0;
122             }
123             }
124              
125 0 0         return wantarray() ? %info : \%info;
126             }
127              
128             1;
129              
130             =head1 NAME
131              
132             Finance::Quote::Fool - Obtain quotes from the Motley Fool web site.
133              
134             =head1 SYNOPSIS
135              
136             use Finance::Quote;
137              
138             $q = Finance::Quote->new;
139              
140             %stockinfo = $q->fetch('fool','GE', 'INTC');
141              
142             =head1 DESCRIPTION
143              
144             This module obtains information from the Motley Fool website
145             (http://caps.fool.com). The site provides date from NASDAQ, NYSE and AMEX.
146              
147             This module is loaded by default on a Finance::Quote object. It's
148             also possible to load it explicitly by placing "Fool" in the argument
149             list to Finance::Quote->new().
150              
151             Information returned by this module is governed by the Motley Fool's terms and
152             conditions.
153              
154             =head1 LABELS RETURNED
155              
156             The following labels may be returned by Finance::Quote::Fool:
157             symbol, day_range, open, volume, close, year_range, last, currency,
158             method.
159              
160             =head1 SEE ALSO
161              
162             Motley Fool, http://caps.fool.com
163              
164             Finance::Quote.
165              
166             =cut