File Coverage

blib/lib/Finance/YahooQuote.pm
Criterion Covered Total %
statement 54 61 88.5
branch 8 16 50.0
condition 0 9 0.0
subroutine 14 16 87.5
pod 0 7 0.0
total 76 109 69.7


line stmt bran cond sub pod time code
1             # perl -w
2             #
3             # Copyright (C) 1998-2002, Dj Padzensky
4             # Copyright (C) 2002-2015 Dirk Eddelbuettel
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., 675 Mass Ave, Cambridge, MA 02139, USA.
19             #
20             # $Id: YahooQuote.pm,v 1.11 2010/03/27 00:44:10 edd Exp $
21              
22             package Finance::YahooQuote;
23             require 5.005;
24              
25             require Exporter;
26 5     5   1846 use strict;
  5         6  
  5         192  
27 5         581 use vars qw($VERSION @EXPORT @ISA
28             $QURL $QURLbase $QURLformat $QURLextended $QURLrealtime $QURLend
29 5     5   20 $TIMEOUT $PROXY $PROXYUSER $PROXYPASSWD);
  5         5  
30              
31 5     5   1041953 use HTTP::Request::Common;
  5         89046  
  5         367  
32 5     5   2396 use Text::ParseWords;
  5         4788  
  5         2559  
33              
34             $VERSION = '0.25';
35              
36             ## these variables govern what type of quote the modules is retrieving
37             $QURLbase = "http://download.finance.yahoo.com/d/quotes.csvr?e=.csv&f=";
38             $QURLbase = "http://download.finance.yahoo.com/d/quotes.csv?e=.csv&f=";
39             $QURLformat = "snl1d1t1c1p2va2bapomwerr1dyj1x"; # default up to 0.19
40             $QURLextended = "s7t8e7e8e9r6r7r5b4p6p5j4m3m4"; # new in 0.20
41             $QURLrealtime = "b2b3k2k1c6m2j3"; # also new in 0.20
42             $QURLend = "&s=";
43             $QURL = $QURLbase . $QURLformat . $QURLend; # define old format as default
44              
45             @ISA = qw(Exporter);
46             @EXPORT = qw(&getquote &getonequote &getcustomquote
47             &setQueryString &useExtendedQueryFormat
48             &useRealtimeQueryFormat);
49             undef $TIMEOUT;
50              
51             ## simple function to switch to extended format
52             sub useExtendedQueryFormat {
53 1     1 0 31 $QURLformat .= $QURLextended;
54             }
55              
56             ## simple function to append real-time format
57             sub useRealtimeQueryFormat {
58 1     1 0 15 $QURLformat .= $QURLrealtime;
59             }
60              
61             ## allow module user to define a new query string
62             sub setQueryString {
63 0     0 0 0 my $format = shift;
64 0         0 $QURLformat = $format;
65             }
66              
67             ## Common function for reading the yahoo site and retrieving and
68             ## parsing the data returned
69             ## The format used is supplied as a second argument, the default function
70             ## getquoye() below uses the default format $QURLformat, and either one of
71             ## the two preceding functions can be used to select the extended format
72             sub readYahoo {
73              
74 6     6 0 11 my @symbols = @{(shift)};
  6         18  
75 6         11 my $format = shift;
76              
77 6         12 my @qr;
78 6         49 my $ua = RequestAgent->new;
79 6         47 $ua->env_proxy; # proxy settings from *_proxy env. variables.
80 6 50       1115151 $ua->proxy('http', $PROXY) if defined $PROXY;
81 6 50       95 $ua->timeout($TIMEOUT) if defined $TIMEOUT;
82              
83             # Loop over the list of symbols, grabbing 199 symbols at a
84             # time, since yahoo only lets you get 200 per request
85 6         127 while ($#symbols > -1) {
86 6 50       41 my @b = $#symbols >= 199 ? splice(@symbols,0,199)
87             : splice(@symbols,0,$#symbols+1);
88              
89 6         35 my $url = "$QURLbase${format}$QURLend".join('+',@b);
90 6         33 foreach (split('\015?\012',$ua->request(GET $url)->content)) {
91 8         1861743 my @q = quotewords(',',0,$_);
92 8         5462 push(@qr,[@q]);
93             }
94             }
95              
96 6         166 return \@qr;
97             }
98              
99             my %fields = (
100             'Symbol' => 's', # old default
101             'Name' => 'n', # old default
102             'Last Trade (With Time)' => 'l',
103             'Last Trade (Price Only)' => 'l1', # old default
104             'Last Trade Date' => 'd1', # old default
105             'Last Trade Time' => 't1', # old default
106             'Last Trade Size' => 'k3',
107             'Change and Percent Change' => 'c',
108             'Change' => 'c1', # old default
109             'Change in Percent' => 'p2', # old default
110             'Ticker Trend' => 't7',
111             'Volume' => 'v', # old default
112             'Average Daily Volume' => 'a2', # old default
113             'More Info' => 'i',
114             'Trade Links' => 't6',
115             'Bid' => 'b', # old default
116             'Bid Size' => 'b6',
117             'Ask' => 'a', # old default
118             'Ask Size' => 'a5',
119             'Previous Close' => 'p', # old default
120             'Open' => 'o', # old default
121             "Day's Range" => 'm', # old default
122             '52-week Range' => 'w', # old default
123             'Change From 52-wk Low' => 'j5',
124             'Pct Chg From 52-wk Low' => 'j6',
125             'Change From 52-wk High' => 'k4',
126             'Pct Chg From 52-wk High' => 'k5',
127             'Earnings/Share' => 'e', # old default
128             'P/E Ratio' => 'r', # old default
129             'Short Ratio' => 's7',
130             'Dividend Pay Date' => 'r1', # old default
131             'Ex-Dividend Date' => 'q',
132             'Dividend/Share' => 'd', # old default
133             'Dividend Yield' => 'y', # old default
134             'Float Shares' => 'f6',
135             'Market Capitalization' => 'j1', # old default
136             '1yr Target Price' => 't8',
137             'EPS Est. Current Yr' => 'e7',
138             'EPS Est. Next Year' => 'e8',
139             'EPS Est. Next Quarter' => 'e9',
140             'Price/EPS Est. Current Yr' => 'r6',
141             'Price/EPS Est. Next Yr' => 'r7',
142             'PEG Ratio' => 'r5',
143             'Book Value' => 'b4',
144             'Price/Book' => 'p6',
145             'Price/Sales' => 'p5',
146             'EBITDA' => 'j4',
147             '50-day Moving Avg' => 'm3',
148             'Change From 50-day Moving Avg' => 'm7',
149             'Pct Chg From 50-day Moving Avg' => 'm8',
150             '200-day Moving Avg' => 'm4',
151             'Change From 200-day Moving Avg' => 'm5',
152             'Pct Chg From 200-day Moving Avg' => 'm6',
153             'Shares Owned' => 's1',
154             'Price Paid' => 'p1',
155             'Commission' => 'c3',
156             'Holdings Value' => 'v1',
157             "Day's Value Change" => 'w1',
158             'Holdings Gain Percent' => 'g1',
159             'Holdings Gain' => 'g4',
160             'Trade Date' => 'd2',
161             'Annualized Gain' => 'g3',
162             'High Limit' => 'l2',
163             'Low Limit' => 'l3',
164             'Notes' => 'n4',
165             'Last Trade (Real-time) with Time'=> 'k1',
166             'Bid (Real-time)' => 'b3',
167             'Ask (Real-time)' => 'b2',
168             'Change Percent (Real-time)' => 'k2',
169             'Change (Real-time)' => 'c6',
170             'Holdings Value (Real-time)' => 'v7',
171             "Day's Value Change (Real-time)" => 'w4',
172             'Holdings Gain Pct (Real-time)' => 'g5',
173             'Holdings Gain (Real-time)' => 'g6',
174             "Day's Range (Real-time)" => 'm2',
175             'Market Cap (Real-time)' => 'j3',
176             'P/E (Real-time)' => 'r2',
177             'After Hours Change (Real-time)' => 'c8',
178             'Order Book (Real-time)' => 'i5',
179             'Stock Exchange' => 'x' # old default
180             );
181              
182             # Let the user define which colums to retrive from yahoo
183             #
184             sub getcustomquote {
185 2     2 0 52 my $symbols = shift;
186 2         3 my $columns = shift;
187              
188 2         4 my $format = join('',map {$fields{$_}} @{$columns});
  6         18  
  2         6  
189              
190 2         9 my $qr = readYahoo($symbols,$format);
191 2 50       69 return wantarray() ? @$qr : $qr;
192             }
193              
194             # get quotes for all symbols in array
195              
196             sub getquote {
197 4     4 0 29 my @symbols = @_;
198              
199 4         8 my $format = $QURLformat; ## Old default from variable
200 4         15 my $qr = readYahoo(\@symbols,$format);
201 4 100       32 return wantarray() ? @$qr : $qr;
202             }
203              
204             # Input: A single stock symbol
205             # Output: An array, containing the list elements mentioned above.
206              
207             sub getonequote {
208 1     1 0 15 my @x;
209 1         5 @x = &getquote($_[0]);
210 1 50       41 return wantarray() ? @{$x[0]} : \@{$x[0]} if @x;
  1 50       14  
  0         0  
211             }
212              
213             BEGIN { # Local variant of LWP::UserAgent that
214 5     5   2171 use LWP; # checks for user/password if document
  5         76563  
  5         218  
215             package RequestAgent; # this code taken from lwp-request, see
216 5     5   44 no strict 'vars'; # the various LWP manual pages
  5         8  
  5         635  
217 5     5   211 @ISA = qw(LWP::UserAgent);
218              
219             sub new {
220 6     6   35 my $self = LWP::UserAgent::new(@_);
221 6         10150 $self->agent("Finance-YahooQuote/0.18");
222 6         285 $self;
223             }
224              
225             sub get_basic_credentials {
226 0     0     my $self = @_;
227 0 0 0       if (defined($PROXYUSER) and defined($PROXYPASSWD) and
      0        
      0        
228             $PROXYUSER ne "" and $PROXYPASSWD ne "") {
229 0           return ($PROXYUSER, $PROXYPASSWD);
230             } else {
231             return (undef, undef)
232 0           }
233             }
234             }
235              
236             1;
237              
238             __END__