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