| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# Copyright 2007, 2008, 2009, 2010, 2011, 2015, 2016, 2017 Kevin Ryde |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This file is part of Chart. |
|
4
|
|
|
|
|
|
|
# |
|
5
|
|
|
|
|
|
|
# Chart is free software; you can redistribute it and/or modify it under the |
|
6
|
|
|
|
|
|
|
# terms of the GNU General Public License as published by the Free Software |
|
7
|
|
|
|
|
|
|
# Foundation; either version 3, or (at your option) any later version. |
|
8
|
|
|
|
|
|
|
# |
|
9
|
|
|
|
|
|
|
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY |
|
10
|
|
|
|
|
|
|
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
|
11
|
|
|
|
|
|
|
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
|
12
|
|
|
|
|
|
|
# details. |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License along |
|
15
|
|
|
|
|
|
|
# with Chart. If not, see <http://www.gnu.org/licenses/>. |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package App::Chart::Yahoo; |
|
19
|
1
|
|
|
1
|
|
62916
|
use 5.010; |
|
|
1
|
|
|
|
|
2
|
|
|
20
|
1
|
|
|
1
|
|
8
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
31
|
|
|
21
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
22
|
|
|
22
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
41
|
|
|
23
|
1
|
|
|
1
|
|
249
|
use Date::Calc; |
|
|
1
|
|
|
|
|
5555
|
|
|
|
1
|
|
|
|
|
31
|
|
|
24
|
1
|
|
|
1
|
|
233
|
use Date::Parse; |
|
|
1
|
|
|
|
|
5120
|
|
|
|
1
|
|
|
|
|
106
|
|
|
25
|
1
|
|
|
1
|
|
6
|
use List::Util qw (min max); |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
47
|
|
|
26
|
1
|
|
|
1
|
|
5
|
use POSIX (); |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
13
|
|
|
27
|
1
|
|
|
1
|
|
226
|
use URI::Escape; |
|
|
1
|
|
|
|
|
1067
|
|
|
|
1
|
|
|
|
|
50
|
|
|
28
|
1
|
|
|
1
|
|
319
|
use Locale::TextDomain ('App-Chart'); |
|
|
1
|
|
|
|
|
15598
|
|
|
|
1
|
|
|
|
|
5
|
|
|
29
|
|
|
|
|
|
|
|
|
30
|
1
|
|
|
1
|
|
5224
|
use Tie::TZ; |
|
|
1
|
|
|
|
|
385
|
|
|
|
1
|
|
|
|
|
30
|
|
|
31
|
1
|
|
|
1
|
|
282
|
use App::Chart; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
use App::Chart::Database; |
|
33
|
|
|
|
|
|
|
use App::Chart::Download; |
|
34
|
|
|
|
|
|
|
use App::Chart::DownloadHandler; |
|
35
|
|
|
|
|
|
|
use App::Chart::DownloadHandler::IndivChunks; |
|
36
|
|
|
|
|
|
|
use App::Chart::IntradayHandler; |
|
37
|
|
|
|
|
|
|
use App::Chart::Latest; |
|
38
|
|
|
|
|
|
|
use App::Chart::Sympred; |
|
39
|
|
|
|
|
|
|
use App::Chart::TZ; |
|
40
|
|
|
|
|
|
|
use App::Chart::Weblink; |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
|
43
|
|
|
|
|
|
|
# use Smart::Comments; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
use constant DEBUG => 0; |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# .X or .XY or no suffix |
|
49
|
|
|
|
|
|
|
our $yahoo_pred = App::Chart::Sympred::Proc->new |
|
50
|
|
|
|
|
|
|
(sub { |
|
51
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
52
|
|
|
|
|
|
|
return ($symbol !~ /\.(FQ|LJ)$/ |
|
53
|
|
|
|
|
|
|
&& $symbol =~ /[.=]..?$|^[^.]+$/); |
|
54
|
|
|
|
|
|
|
}); |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $download_pred = App::Chart::Sympred::Any->new ($yahoo_pred); |
|
57
|
|
|
|
|
|
|
our $latest_pred = App::Chart::Sympred::Any->new ($yahoo_pred); |
|
58
|
|
|
|
|
|
|
our $index_pred = App::Chart::Sympred::Regexp->new (qr/^\^|^0.*\.SS$/); |
|
59
|
|
|
|
|
|
|
my $futures_pred = App::Chart::Sympred::Any->new; |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# max symbols to any /q? quotes request |
|
62
|
|
|
|
|
|
|
# Finance::Quote::Yahoo uses a limit of 40 to stop the url getting too |
|
63
|
|
|
|
|
|
|
# long, which apparently some servers or proxies can't handle |
|
64
|
|
|
|
|
|
|
use constant MAX_QUOTES => 40; |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# overridden by specific nodes |
|
67
|
|
|
|
|
|
|
App::Chart::setup_source_help |
|
68
|
|
|
|
|
|
|
($yahoo_pred, __p('manual-node','Yahoo Finance')); |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
72
|
|
|
|
|
|
|
# web link - basic quote page |
|
73
|
|
|
|
|
|
|
# |
|
74
|
|
|
|
|
|
|
# Eg. http://finance.yahoo.com/q?s=BHP.AX |
|
75
|
|
|
|
|
|
|
# |
|
76
|
|
|
|
|
|
|
# The accelerator is "_Y" so as not to clash with "_S" for stock on various |
|
77
|
|
|
|
|
|
|
# stock exchange links like "ASX IRM _Stock Information" |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
App::Chart::Weblink->new |
|
80
|
|
|
|
|
|
|
(pred => $yahoo_pred, |
|
81
|
|
|
|
|
|
|
name => __('_Yahoo Stock Page'), |
|
82
|
|
|
|
|
|
|
desc => __('Open web browser at the Yahoo quote page for this stock'), |
|
83
|
|
|
|
|
|
|
proc => sub { |
|
84
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
85
|
|
|
|
|
|
|
return "http://" |
|
86
|
|
|
|
|
|
|
. App::Chart::Database->preference_get ('yahoo-quote-host', |
|
87
|
|
|
|
|
|
|
'finance.yahoo.com') |
|
88
|
|
|
|
|
|
|
. "/q?s=" |
|
89
|
|
|
|
|
|
|
. URI::Escape::uri_escape($symbol); |
|
90
|
|
|
|
|
|
|
}); |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
94
|
|
|
|
|
|
|
# misc |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# (if (and (yahoo-futures-symbol? symbol) |
|
98
|
|
|
|
|
|
|
# (not (chart-symbol-mdate symbol))) |
|
99
|
|
|
|
|
|
|
# (let* ((want-tdate (adate->tdate |
|
100
|
|
|
|
|
|
|
# (first |
|
101
|
|
|
|
|
|
|
# (yahoo-quote-adate-time symbol "")))) |
|
102
|
|
|
|
|
|
|
# (mdate (or (latest-symbol-mdate-nodownload symbol |
|
103
|
|
|
|
|
|
|
# want-tdate) |
|
104
|
|
|
|
|
|
|
# (begin |
|
105
|
|
|
|
|
|
|
# (weblink-message |
|
106
|
|
|
|
|
|
|
# (_ "Finding front month ...")) |
|
107
|
|
|
|
|
|
|
# (latest-symbol-mdate symbol want-tdate))))) |
|
108
|
|
|
|
|
|
|
# (if mdate # might still be unknown |
|
109
|
|
|
|
|
|
|
# (set! symbol |
|
110
|
|
|
|
|
|
|
# (string-append (chart-symbol-commodity symbol) |
|
111
|
|
|
|
|
|
|
# (mdate->MYY-str mdate) |
|
112
|
|
|
|
|
|
|
# (chart-symbol-suffix symbol)))))) |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
116
|
|
|
|
|
|
|
# Exchanges page for quote delays |
|
117
|
|
|
|
|
|
|
# |
|
118
|
|
|
|
|
|
|
# This looks at the exchanges page |
|
119
|
|
|
|
|
|
|
# |
|
120
|
|
|
|
|
|
|
use constant EXCHANGES_URL => 'https://help.yahoo.com/kb/SLN2310.html'; |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# Exchanges page was previously http://finance.yahoo.com/exchanges, but why |
|
123
|
|
|
|
|
|
|
# would they keep it the same when breaking everybody's links would be |
|
124
|
|
|
|
|
|
|
# better. |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# refetch the exchanges page after this many days |
|
127
|
|
|
|
|
|
|
use constant EXCHANGES_UPDATE_DAYS => 7; |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# containing arefs [$pred,'.XX'] |
|
130
|
|
|
|
|
|
|
my @quote_delay_aliases; |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub setup_quote_delay_alias { |
|
133
|
|
|
|
|
|
|
my ($pred, $suffix) = @_; |
|
134
|
|
|
|
|
|
|
push @quote_delay_aliases, [ $pred, $suffix ]; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub symbol_quote_delay { |
|
138
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# indexes all in real time |
|
141
|
|
|
|
|
|
|
if ($index_pred->match($symbol)) { |
|
142
|
|
|
|
|
|
|
return 0; |
|
143
|
|
|
|
|
|
|
} |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
my $suffix = App::Chart::symbol_suffix ($symbol); |
|
146
|
|
|
|
|
|
|
my $h = exchanges_data(); |
|
147
|
|
|
|
|
|
|
my $delay = $h->{$suffix}; |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
if (! defined $delay) { |
|
150
|
|
|
|
|
|
|
if (my $elem = List::Util::first { $_->[0]->match ($symbol) } |
|
151
|
|
|
|
|
|
|
@quote_delay_aliases) { |
|
152
|
|
|
|
|
|
|
$suffix = $elem->[1]; |
|
153
|
|
|
|
|
|
|
$delay = $h->{$suffix}; |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
} |
|
156
|
|
|
|
|
|
|
if (! defined $delay) { |
|
157
|
|
|
|
|
|
|
# guess default 20 minutes |
|
158
|
|
|
|
|
|
|
$delay = 20; |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
return $delay; |
|
161
|
|
|
|
|
|
|
} |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# return a hashref of exchange delay data like { '.AX' => 20, '.BI' => 15 } |
|
164
|
|
|
|
|
|
|
sub exchanges_data { |
|
165
|
|
|
|
|
|
|
require App::Chart::Pagebits; |
|
166
|
|
|
|
|
|
|
return App::Chart::Pagebits::get |
|
167
|
|
|
|
|
|
|
(name => __('Yahoo exchanges page'), |
|
168
|
|
|
|
|
|
|
url => EXCHANGES_URL, |
|
169
|
|
|
|
|
|
|
key => 'yahoo-quote-delays', |
|
170
|
|
|
|
|
|
|
freq_days => EXCHANGES_UPDATE_DAYS, |
|
171
|
|
|
|
|
|
|
parse => \&exchanges_parse); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
sub exchanges_parse { |
|
174
|
|
|
|
|
|
|
my ($content) = @_; |
|
175
|
|
|
|
|
|
|
my $h = {}; |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
require HTML::TableExtract; |
|
178
|
|
|
|
|
|
|
my $te = HTML::TableExtract->new (headers => ['Suffix', 'Delay']); |
|
179
|
|
|
|
|
|
|
$te->parse($content); |
|
180
|
|
|
|
|
|
|
if (! $te->tables) { |
|
181
|
|
|
|
|
|
|
warn "Yahoo exchanges page unrecognised, assuming 15 min quote delay"; |
|
182
|
|
|
|
|
|
|
return $h; |
|
183
|
|
|
|
|
|
|
} |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
foreach my $row ($te->rows) { |
|
186
|
|
|
|
|
|
|
my $suffix = $row->[0]; |
|
187
|
|
|
|
|
|
|
my $delay = $row->[1]; |
|
188
|
|
|
|
|
|
|
next if ($suffix eq 'N/A'); |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# eg "15 min" |
|
191
|
|
|
|
|
|
|
# or "15 min**" with footnote |
|
192
|
|
|
|
|
|
|
# |
|
193
|
|
|
|
|
|
|
if ($delay =~ /^(\d+) min/) { |
|
194
|
|
|
|
|
|
|
$delay = $1; |
|
195
|
|
|
|
|
|
|
} elsif ($delay =~ /real/i) { |
|
196
|
|
|
|
|
|
|
$delay = 0; |
|
197
|
|
|
|
|
|
|
} else { |
|
198
|
|
|
|
|
|
|
warn "Yahoo exchanges page unrecognised delay: \"$delay\"\n"; |
|
199
|
|
|
|
|
|
|
next; |
|
200
|
|
|
|
|
|
|
} |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
$h->{$suffix} = $delay + 0; |
|
203
|
|
|
|
|
|
|
} |
|
204
|
|
|
|
|
|
|
return $h; |
|
205
|
|
|
|
|
|
|
} |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
209
|
|
|
|
|
|
|
# Quotes bits generally. |
|
210
|
|
|
|
|
|
|
# |
|
211
|
|
|
|
|
|
|
# This uses the csv format quotes like |
|
212
|
|
|
|
|
|
|
# |
|
213
|
|
|
|
|
|
|
# http://download.finance.yahoo.com/d/quotes.csv?f=snl&e=.csv&s=BHP.AX |
|
214
|
|
|
|
|
|
|
# |
|
215
|
|
|
|
|
|
|
# The "f" field keys can be found at the following (open an account to get |
|
216
|
|
|
|
|
|
|
# to them). |
|
217
|
|
|
|
|
|
|
# |
|
218
|
|
|
|
|
|
|
# http://edit.my.yahoo.com/config/edit_pfview?.vk=v1 |
|
219
|
|
|
|
|
|
|
# http://edit.finance.yahoo.com/e9?.intl=au |
|
220
|
|
|
|
|
|
|
# |
|
221
|
|
|
|
|
|
|
# http://download.finance.yahoo.com/d? |
|
222
|
|
|
|
|
|
|
# s= # symbol |
|
223
|
|
|
|
|
|
|
# f= # format, concat of the following |
|
224
|
|
|
|
|
|
|
# s # symbol |
|
225
|
|
|
|
|
|
|
# n # company name |
|
226
|
|
|
|
|
|
|
# l1 # last price |
|
227
|
|
|
|
|
|
|
# d1 # last trade date (in home exchange's timezone) |
|
228
|
|
|
|
|
|
|
# t1 # last trade time (in yahoo server timezone) |
|
229
|
|
|
|
|
|
|
# c1 # change |
|
230
|
|
|
|
|
|
|
# p2 # percent change |
|
231
|
|
|
|
|
|
|
# v # volume |
|
232
|
|
|
|
|
|
|
# a2 # average daily volume |
|
233
|
|
|
|
|
|
|
# b # bid |
|
234
|
|
|
|
|
|
|
# b6 # bid size |
|
235
|
|
|
|
|
|
|
# a # ask |
|
236
|
|
|
|
|
|
|
# a5 # ask size |
|
237
|
|
|
|
|
|
|
# k1 # "time - last" (ECN), with <b> and <i> markup |
|
238
|
|
|
|
|
|
|
# c6 # change (ECN) |
|
239
|
|
|
|
|
|
|
# m2 # day's range (ECN) |
|
240
|
|
|
|
|
|
|
# b3 # bid (ECN) |
|
241
|
|
|
|
|
|
|
# b2 # ask (ECN) |
|
242
|
|
|
|
|
|
|
# p # previous close |
|
243
|
|
|
|
|
|
|
# o # today's open |
|
244
|
|
|
|
|
|
|
# m # day's range, eg. "1.23 - 4.56" |
|
245
|
|
|
|
|
|
|
# w # 52-week range, eg. "1.23 - 4.56" |
|
246
|
|
|
|
|
|
|
# e # earnings per share |
|
247
|
|
|
|
|
|
|
# r # p/e ratio |
|
248
|
|
|
|
|
|
|
# d # div per share |
|
249
|
|
|
|
|
|
|
# q # ex div date, eg. "Mar 31" or "N/A" |
|
250
|
|
|
|
|
|
|
# r1 # div pay date |
|
251
|
|
|
|
|
|
|
# y # div yield |
|
252
|
|
|
|
|
|
|
# j1 # market cap |
|
253
|
|
|
|
|
|
|
# x # stock exchange |
|
254
|
|
|
|
|
|
|
# c4 # currency, eg. "AUD" |
|
255
|
|
|
|
|
|
|
# i # more info links, letters |
|
256
|
|
|
|
|
|
|
# # c=chart, n=news, p=profile, r=research, i=insider, |
|
257
|
|
|
|
|
|
|
# # m=message board (yahoo) |
|
258
|
|
|
|
|
|
|
# k # 52-week high |
|
259
|
|
|
|
|
|
|
# |
|
260
|
|
|
|
|
|
|
# Don't know what the distinction between b,a and b3,b2 quotes are actually |
|
261
|
|
|
|
|
|
|
# meant to be. |
|
262
|
|
|
|
|
|
|
# - For the Australian Stock Exchange, b,a are "N/A", and b3,b2 is the |
|
263
|
|
|
|
|
|
|
# SEATS best quote. |
|
264
|
|
|
|
|
|
|
# - For US stocks b,a seem to be "N/A", and b3,b2 an ECN quote. The |
|
265
|
|
|
|
|
|
|
# latter has been seen a long way away from from recent trades though, |
|
266
|
|
|
|
|
|
|
# eg. in BRK-A. |
|
267
|
|
|
|
|
|
|
# |
|
268
|
|
|
|
|
|
|
# d1,t1 are a bit odd, the time is the yahoo server's zone, but the date |
|
269
|
|
|
|
|
|
|
# seems to be always GMT. The zone for the time can be seen easily by |
|
270
|
|
|
|
|
|
|
# looking at a quote from the various international XX.finance.yahoo.com. |
|
271
|
|
|
|
|
|
|
# For the zone for the date however you need to be watching at midnight |
|
272
|
|
|
|
|
|
|
# GMT, where it ticks over (at all the international XX.finance.yahoo.com). |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# quote_parse_div_date ($str) returns an iso YYYY-MM-DD date string for a |
|
276
|
|
|
|
|
|
|
# dividend $str coming from quote.csv data, or undef if none. There are |
|
277
|
|
|
|
|
|
|
# several different formats, |
|
278
|
|
|
|
|
|
|
# "Jan 7" # finance.yahoo.com |
|
279
|
|
|
|
|
|
|
# " 5 Jan" # au.finance, uk.finance |
|
280
|
|
|
|
|
|
|
# "24-Sep-04" # ABB.AX on finance.yahoo.com |
|
281
|
|
|
|
|
|
|
# "24 Sep, 2004" # ABB.AX on au.finance |
|
282
|
|
|
|
|
|
|
# "Sep 24, 2004" # ABB.AX on ca.finance |
|
283
|
|
|
|
|
|
|
# |
|
284
|
|
|
|
|
|
|
# An error is thrown for an unrecognised string, don't want some new form to |
|
285
|
|
|
|
|
|
|
# end up with dividends silently forgotten. |
|
286
|
|
|
|
|
|
|
# |
|
287
|
|
|
|
|
|
|
sub quote_parse_div_date { |
|
288
|
|
|
|
|
|
|
my ($str) = @_; |
|
289
|
|
|
|
|
|
|
if (DEBUG) { print "quote_parse_div_date() '$str'\n"; } |
|
290
|
|
|
|
|
|
|
if (! defined $str || $str eq 'N/A' || $str eq '') { |
|
291
|
|
|
|
|
|
|
return undef; # no info |
|
292
|
|
|
|
|
|
|
} |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
my ($ss,$mm,$hh,$day,$month,$year,$zone) = Date::Parse::strptime ($str); |
|
295
|
|
|
|
|
|
|
$month++; |
|
296
|
|
|
|
|
|
|
if ($year) { |
|
297
|
|
|
|
|
|
|
$year += 1900; |
|
298
|
|
|
|
|
|
|
if ($year < 2000) { # "04" returned as 1904, bump to 2004 |
|
299
|
|
|
|
|
|
|
$year += 100; |
|
300
|
|
|
|
|
|
|
} |
|
301
|
|
|
|
|
|
|
} else { |
|
302
|
|
|
|
|
|
|
# year not given, try nearest |
|
303
|
|
|
|
|
|
|
$year = App::Chart::Download::month_to_nearest_year ($month); |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
if (! Date::Calc::check_date ($year, $month, $day)) { |
|
306
|
|
|
|
|
|
|
warn "Yahoo invalid dividend date '$str'"; |
|
307
|
|
|
|
|
|
|
} |
|
308
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year, $month, $day); |
|
309
|
|
|
|
|
|
|
} |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
312
|
|
|
|
|
|
|
# latest |
|
313
|
|
|
|
|
|
|
# |
|
314
|
|
|
|
|
|
|
# wget -S -O /dev/stdout 'http://download.finance.yahoo.com/d/quotes.csv?f=snc4b3b2d1t1oml1c1vqdx&e=.csv&s=GM' |
|
315
|
|
|
|
|
|
|
# |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
use constant DEFAULT_DOWNLOAD_HOST => 'download.finance.yahoo.com'; |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
App::Chart::LatestHandler->new |
|
320
|
|
|
|
|
|
|
(pred => $latest_pred, |
|
321
|
|
|
|
|
|
|
proc => \&latest_download, |
|
322
|
|
|
|
|
|
|
max_symbols => MAX_QUOTES); |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub latest_download { |
|
325
|
|
|
|
|
|
|
my ($symbol_list) = @_; |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
App::Chart::Download::status |
|
328
|
|
|
|
|
|
|
(__x('Yahoo quotes {symbol_range}', |
|
329
|
|
|
|
|
|
|
symbol_range => |
|
330
|
|
|
|
|
|
|
App::Chart::Download::symbol_range_string ($symbol_list))); |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my $host = App::Chart::Database->preference_get |
|
333
|
|
|
|
|
|
|
('yahoo-quote-host', DEFAULT_DOWNLOAD_HOST); |
|
334
|
|
|
|
|
|
|
my $url = "http://$host/d/quotes.csv?f=snc4b3b2d1t1oml1c1vqdx&e=.csv&s=" |
|
335
|
|
|
|
|
|
|
. join (',', map { URI::Escape::uri_escape($_) } @$symbol_list); |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my $resp = App::Chart::Download->get ($url); |
|
338
|
|
|
|
|
|
|
App::Chart::Download::write_latest_group (latest_parse ($resp)); |
|
339
|
|
|
|
|
|
|
} |
|
340
|
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub latest_parse { |
|
342
|
|
|
|
|
|
|
my ($resp) = @_; |
|
343
|
|
|
|
|
|
|
my $content = $resp->decoded_content (raise_error => 1); |
|
344
|
|
|
|
|
|
|
### Yahoo quotes: $content |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
my @data = (); |
|
347
|
|
|
|
|
|
|
my $h = { source => __PACKAGE__, |
|
348
|
|
|
|
|
|
|
resp => $resp, |
|
349
|
|
|
|
|
|
|
prefer_decimals => 2, |
|
350
|
|
|
|
|
|
|
date_format => 'mdy', # eg. '6/26/2015' |
|
351
|
|
|
|
|
|
|
data => \@data }; |
|
352
|
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
require Text::CSV_XS; |
|
354
|
|
|
|
|
|
|
my $csv = Text::CSV_XS->new; |
|
355
|
|
|
|
|
|
|
foreach my $line (App::Chart::Download::split_lines ($content)) { |
|
356
|
|
|
|
|
|
|
$csv->parse($line); |
|
357
|
|
|
|
|
|
|
### csv fields: $csv->fields() |
|
358
|
|
|
|
|
|
|
my ($symbol, $name, $currency, $bid, $offer, $last_date, $last_time, |
|
359
|
|
|
|
|
|
|
$open, $range, $last, $change, $volume, |
|
360
|
|
|
|
|
|
|
$div_date, $div_amount, $exchange) |
|
361
|
|
|
|
|
|
|
= $csv->fields(); |
|
362
|
|
|
|
|
|
|
if (! defined $symbol) { |
|
363
|
|
|
|
|
|
|
# blank line maybe |
|
364
|
|
|
|
|
|
|
print "Yahoo quotes blank line maybe:\n---\n$content\n---\n"; |
|
365
|
|
|
|
|
|
|
next; |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# for unknown stocks the name is a repeat of the symbol, which is pretty |
|
369
|
|
|
|
|
|
|
# useless |
|
370
|
|
|
|
|
|
|
if ($name eq $symbol) { $name = undef; } |
|
371
|
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
my ($low, $high) = split /-/, $range; |
|
373
|
|
|
|
|
|
|
my $quote_delay_minutes = symbol_quote_delay ($symbol); |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# have seen wildly garbage date for unknown symbols, like |
|
376
|
|
|
|
|
|
|
# GC.CMX","GC.CMX","MRA",N/A,N/A,"8/352/19019","4:58am",N/A,"N/A - N/A",0.00,N/A,N/A,"N/A",N/A,"N/A |
|
377
|
|
|
|
|
|
|
# depending what else in the same request ... |
|
378
|
|
|
|
|
|
|
# |
|
379
|
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# In the past date/times were in New York timezone, for shares anywhere |
|
381
|
|
|
|
|
|
|
# in the world. The Chart database is in the timezone of the exchange. |
|
382
|
|
|
|
|
|
|
# As of June 2015 believe Yahoo is now also the exchange timezone so no |
|
383
|
|
|
|
|
|
|
# transformation. |
|
384
|
|
|
|
|
|
|
# |
|
385
|
|
|
|
|
|
|
# my $symbol_timezone = App::Chart::TZ->for_symbol ($symbol); |
|
386
|
|
|
|
|
|
|
# ($last_date, $last_time) |
|
387
|
|
|
|
|
|
|
# = quote_parse_datetime ($last_date, $last_time, |
|
388
|
|
|
|
|
|
|
# App::Chart::TZ->newyork, |
|
389
|
|
|
|
|
|
|
# $symbol_timezone); |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# dividend is "0.00" for various unknowns or estimates, eg. from ASX |
|
392
|
|
|
|
|
|
|
# trusts |
|
393
|
|
|
|
|
|
|
if (App::Chart::Download::str_is_zero ($div_amount)) { |
|
394
|
|
|
|
|
|
|
$div_amount = __('unknown'); |
|
395
|
|
|
|
|
|
|
} |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# dividend shown only if it's today |
|
398
|
|
|
|
|
|
|
# don't show if no last_date, just in case have a div_date but no |
|
399
|
|
|
|
|
|
|
# last_date for some reason |
|
400
|
|
|
|
|
|
|
$div_date = quote_parse_div_date ($div_date); |
|
401
|
|
|
|
|
|
|
if (! ($div_date && $last_date && $div_date eq $last_date)) { |
|
402
|
|
|
|
|
|
|
$div_amount = undef; |
|
403
|
|
|
|
|
|
|
} |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
push @data, { symbol => $symbol, |
|
406
|
|
|
|
|
|
|
name => $name, |
|
407
|
|
|
|
|
|
|
exchange => $exchange, |
|
408
|
|
|
|
|
|
|
currency => $currency, |
|
409
|
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
quote_delay_minutes => $quote_delay_minutes, |
|
411
|
|
|
|
|
|
|
bid => $bid, |
|
412
|
|
|
|
|
|
|
offer => $offer, |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
last_date => $last_date, |
|
415
|
|
|
|
|
|
|
last_time => $last_time, |
|
416
|
|
|
|
|
|
|
open => $open, |
|
417
|
|
|
|
|
|
|
high => $high, |
|
418
|
|
|
|
|
|
|
low => $low, |
|
419
|
|
|
|
|
|
|
last => $last, |
|
420
|
|
|
|
|
|
|
change => $change, |
|
421
|
|
|
|
|
|
|
volume => $volume, |
|
422
|
|
|
|
|
|
|
dividend => $div_amount, |
|
423
|
|
|
|
|
|
|
}; |
|
424
|
|
|
|
|
|
|
} |
|
425
|
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
### $h |
|
427
|
|
|
|
|
|
|
return $h; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub mktime_in_zone { |
|
431
|
|
|
|
|
|
|
my ($sec, $min, $hour, $mday, $mon, $year, $zone) = @_; |
|
432
|
|
|
|
|
|
|
my $timet; |
|
433
|
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
{ local $Tie::TZ::TZ = $zone->tz; |
|
435
|
|
|
|
|
|
|
$timet = POSIX::mktime ($sec, $min, $hour, |
|
436
|
|
|
|
|
|
|
$mday, $mon, $year, 0,0,0); |
|
437
|
|
|
|
|
|
|
my ($Xsec,$Xmin,$Xhour,$Xmday,$Xmon,$Xyear,$wday,$yday,$isdst) |
|
438
|
|
|
|
|
|
|
= localtime ($timet); |
|
439
|
|
|
|
|
|
|
return POSIX::mktime ($sec, $min, $hour, |
|
440
|
|
|
|
|
|
|
$mday, $mon, $year, $wday,$yday,$isdst); |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
} |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# $date is dmy like 7/15/2007, in GMT |
|
445
|
|
|
|
|
|
|
# $time is h:mp like 10:05am, in $server_zone |
|
446
|
|
|
|
|
|
|
# |
|
447
|
|
|
|
|
|
|
# return ($date, $time) iso strings like ('2008-06-11', '10:55:00') in |
|
448
|
|
|
|
|
|
|
# $want_zone |
|
449
|
|
|
|
|
|
|
# |
|
450
|
|
|
|
|
|
|
sub quote_parse_datetime { |
|
451
|
|
|
|
|
|
|
my ($date, $time, $server_zone, $want_zone) = @_; |
|
452
|
|
|
|
|
|
|
if (DEBUG) { print "quote_parse_datetime $date, $time\n"; } |
|
453
|
|
|
|
|
|
|
if ($date eq 'N/A' || $time eq 'N/A') { return (undef, undef); } |
|
454
|
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year) |
|
456
|
|
|
|
|
|
|
= Date::Parse::strptime($date . ' ' . $time); |
|
457
|
|
|
|
|
|
|
$sec //= 0; # undef if not present |
|
458
|
|
|
|
|
|
|
if (DEBUG) { print " parse $sec,$min,$hour,$mday,$mon,$year\n"; } |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
my $timet = mktime_in_zone ($sec, $min, $hour, |
|
461
|
|
|
|
|
|
|
$mday, $mon, $year, $server_zone); |
|
462
|
|
|
|
|
|
|
if (DEBUG) { |
|
463
|
|
|
|
|
|
|
print " timet Serv ",do { local $Tie::TZ::TZ = $server_zone->tz; |
|
464
|
|
|
|
|
|
|
POSIX::ctime($timet) }; |
|
465
|
|
|
|
|
|
|
print " timet GMT ",do { local $Tie::TZ::TZ = 'GMT'; |
|
466
|
|
|
|
|
|
|
POSIX::ctime($timet) }; |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
my ($gmt_sec,$gmt_min,$gmt_hour,$gmt_mday,$gmt_mon,$gmt_year,$gmt_wday,$gmt_yday,$gmt_isdst) = gmtime ($timet); |
|
470
|
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
if ($gmt_mday != $mday) { |
|
472
|
|
|
|
|
|
|
if (DEBUG) { print " mday $mday/$mon cf gmt_mday $gmt_mday/$gmt_mon, at $timet\n"; } |
|
473
|
|
|
|
|
|
|
if (cmp_modulo ($gmt_mday, $mday, 31) < 0) { |
|
474
|
|
|
|
|
|
|
$mday++; |
|
475
|
|
|
|
|
|
|
} else { |
|
476
|
|
|
|
|
|
|
$mday--; |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
$timet = mktime_in_zone ($sec, $min, $hour, |
|
479
|
|
|
|
|
|
|
$mday, $mon, $year, $server_zone); |
|
480
|
|
|
|
|
|
|
if (DEBUG) { print " switch to $mday giving $timet = $timet\n"; } |
|
481
|
|
|
|
|
|
|
if (DEBUG) { |
|
482
|
|
|
|
|
|
|
print " timet GMT ",do { local $Tie::TZ::TZ = 'GMT'; |
|
483
|
|
|
|
|
|
|
POSIX::ctime($timet) }; |
|
484
|
|
|
|
|
|
|
print " timet Targ ",do { local $Tie::TZ::TZ = $want_zone->tz; |
|
485
|
|
|
|
|
|
|
POSIX::ctime($timet) }; |
|
486
|
|
|
|
|
|
|
} |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
return $want_zone->iso_date_time ($timet); |
|
489
|
|
|
|
|
|
|
} |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub cmp_modulo { |
|
492
|
|
|
|
|
|
|
my ($x, $y, $modulus) = @_; |
|
493
|
|
|
|
|
|
|
my $half = int ($modulus / 2); |
|
494
|
|
|
|
|
|
|
return (($x - $y + $half) % $modulus) <=> $half; |
|
495
|
|
|
|
|
|
|
} |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub decode_hms { |
|
498
|
|
|
|
|
|
|
my ($str) = @_; |
|
499
|
|
|
|
|
|
|
my ($hour, $minute, $second) = split /:/, $str; |
|
500
|
|
|
|
|
|
|
if (! defined $second) { $second = 0; } |
|
501
|
|
|
|
|
|
|
return ($hour, $minute, $second); |
|
502
|
|
|
|
|
|
|
} |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
506
|
|
|
|
|
|
|
# download |
|
507
|
|
|
|
|
|
|
# |
|
508
|
|
|
|
|
|
|
# This uses the historical prices page like |
|
509
|
|
|
|
|
|
|
# |
|
510
|
|
|
|
|
|
|
# https://finance.yahoo.com/quote/AMP.AX/history?p=AMP.AX |
|
511
|
|
|
|
|
|
|
# |
|
512
|
|
|
|
|
|
|
# which puts a cookie like |
|
513
|
|
|
|
|
|
|
# |
|
514
|
|
|
|
|
|
|
# Set-Cookie: B=fab5sl9cqn2rd&b=3&s=i3; expires=Sun, 03-Sep-2018 04:56:13 GMT; path=/; domain=.yahoo.com |
|
515
|
|
|
|
|
|
|
# |
|
516
|
|
|
|
|
|
|
# and contains buried within a mountain of hideous script |
|
517
|
|
|
|
|
|
|
# |
|
518
|
|
|
|
|
|
|
# "CrumbStore":{"crumb":"hdDX\u002FHGsZ0Q"} |
|
519
|
|
|
|
|
|
|
# |
|
520
|
|
|
|
|
|
|
# The \u002F is backslash character etc which is script string for "/" |
|
521
|
|
|
|
|
|
|
# character. The crumb is included in a CSV download query like |
|
522
|
|
|
|
|
|
|
# |
|
523
|
|
|
|
|
|
|
# https://query1.finance.yahoo.com/v7/finance/download/AMP.AX?period1=1503810440&period2=1504415240&interval=1d&events=history&crumb=hdDX/HGsZ0Q |
|
524
|
|
|
|
|
|
|
# |
|
525
|
|
|
|
|
|
|
# period1 is the start time, period2 the end time, both as Unix seconds |
|
526
|
|
|
|
|
|
|
# since 1 Jan 1970. Not sure of the timezone needed. Some experiments |
|
527
|
|
|
|
|
|
|
# suggest it depends on the timezone of the symbol. http works as well as |
|
528
|
|
|
|
|
|
|
# https. The result is like |
|
529
|
|
|
|
|
|
|
# |
|
530
|
|
|
|
|
|
|
# Date,Open,High,Low,Close,Adj Close,Volume |
|
531
|
|
|
|
|
|
|
# 2017-09-07,30.299999,30.379999,30.000000,30.170000,30.170000,3451099 |
|
532
|
|
|
|
|
|
|
# |
|
533
|
|
|
|
|
|
|
# The "9999s" are some dodgy rounding off to what should be usually at most |
|
534
|
|
|
|
|
|
|
# 3 decimal places. |
|
535
|
|
|
|
|
|
|
# |
|
536
|
|
|
|
|
|
|
# Response is 404 if no such symbol, 401 unauthorized if no cookie or crumb. |
|
537
|
|
|
|
|
|
|
# |
|
538
|
|
|
|
|
|
|
# "events=div" gives dividends like |
|
539
|
|
|
|
|
|
|
# |
|
540
|
|
|
|
|
|
|
# Date,Dividends |
|
541
|
|
|
|
|
|
|
# 2017-08-11,0.161556 |
|
542
|
|
|
|
|
|
|
# |
|
543
|
|
|
|
|
|
|
# "events=div" gives splits like, for a consolidation (GXY.AX) |
|
544
|
|
|
|
|
|
|
# |
|
545
|
|
|
|
|
|
|
# Date,Stock Splits |
|
546
|
|
|
|
|
|
|
# 2017-05-22,1/5 |
|
547
|
|
|
|
|
|
|
# |
|
548
|
|
|
|
|
|
|
#---------------- |
|
549
|
|
|
|
|
|
|
# For reference, there's a similar further which is json format (%7C = "|") |
|
550
|
|
|
|
|
|
|
# |
|
551
|
|
|
|
|
|
|
# https://query2.finance.yahoo.com/v8/finance/chart/IBM?formatted=true&lang=en-US®ion=US&period1=1504028419&period2=1504428419&interval=1d&events=div%7Csplit&corsDomain=finance.yahoo.com |
|
552
|
|
|
|
|
|
|
# |
|
553
|
|
|
|
|
|
|
# This doesn't require a cookie and crumb, has some info like symbol |
|
554
|
|
|
|
|
|
|
# timezone. The numbers look like they're rounded through 32-bit floating |
|
555
|
|
|
|
|
|
|
# point, for example "142.55999755859375" which is 142.55 in a 23-bit |
|
556
|
|
|
|
|
|
|
# mantissa. log(14255000)/log(2) = 23.76 bits |
|
557
|
|
|
|
|
|
|
# |
|
558
|
|
|
|
|
|
|
# All prices look like they are split-adjusted, which is ok if that's what |
|
559
|
|
|
|
|
|
|
# you ant and are downloading a full data set, but bad for incremental since |
|
560
|
|
|
|
|
|
|
# you don't know when a change is applied. |
|
561
|
|
|
|
|
|
|
# |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
App::Chart::DownloadHandler->new |
|
564
|
|
|
|
|
|
|
(name => __('Yahoo'), |
|
565
|
|
|
|
|
|
|
pred => $download_pred, |
|
566
|
|
|
|
|
|
|
available_tdate_by_symbol => \&daily_available_tdate, |
|
567
|
|
|
|
|
|
|
available_tdate_extra => 2, |
|
568
|
|
|
|
|
|
|
url_and_cookiejar_func => \&daily_url_and_cookiejar, |
|
569
|
|
|
|
|
|
|
proc => \&daily_download, |
|
570
|
|
|
|
|
|
|
chunk_size => 150); |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub daily_available_tdate { |
|
573
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Sep 2017: daily data is present for the current day's trade, during the |
|
576
|
|
|
|
|
|
|
# trading session. Try reckoning it complete at 6pm. |
|
577
|
|
|
|
|
|
|
return App::Chart::Download::tdate_today_after |
|
578
|
|
|
|
|
|
|
(18,0, App::Chart::TZ->for_symbol ($symbol)); |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# return App::Chart::Download::tdate_today_after |
|
581
|
|
|
|
|
|
|
# (10,30, App::Chart::TZ->for_symbol ($symbol)) |
|
582
|
|
|
|
|
|
|
# - 1; |
|
583
|
|
|
|
|
|
|
} |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub daily_download { |
|
586
|
|
|
|
|
|
|
my ($symbol_list) = @_; |
|
587
|
|
|
|
|
|
|
App::Chart::Download::status (__('Yahoo daily data')); |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# App::Chart::Download::verbose_message ("Yahoo crumb $crumb cookies\n" |
|
590
|
|
|
|
|
|
|
# . $jar->as_string); |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
my $crumb_errors = 0; |
|
593
|
|
|
|
|
|
|
SYMBOL: foreach my $symbol (@$symbol_list) { |
|
594
|
|
|
|
|
|
|
my $lo_tdate = App::Chart::Download::start_tdate_for_update (@$symbol_list); |
|
595
|
|
|
|
|
|
|
my $hi_tdate = daily_available_tdate ($symbol); |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
App::Chart::Download::status |
|
598
|
|
|
|
|
|
|
(__('Yahoo data'), $symbol, |
|
599
|
|
|
|
|
|
|
App::Chart::Download::tdate_range_string ($lo_tdate, $hi_tdate)); |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
my $lo_timet = tdate_to_unix($lo_tdate - 2); |
|
602
|
|
|
|
|
|
|
my $hi_timet = tdate_to_unix($hi_tdate + 2); |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
my $data = daily_cookie_data($symbol); |
|
605
|
|
|
|
|
|
|
if (! defined $data) { |
|
606
|
|
|
|
|
|
|
print "Yahoo $symbol does not exist"; |
|
607
|
|
|
|
|
|
|
next SYMBOL; |
|
608
|
|
|
|
|
|
|
} |
|
609
|
|
|
|
|
|
|
my $crumb = URI::Escape::uri_escape($data->{'crumb'}); |
|
610
|
|
|
|
|
|
|
my $jar = http_cookies_from_string($data->{'cookies'} // ''); |
|
611
|
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
my $h = { source => __PACKAGE__, |
|
613
|
|
|
|
|
|
|
prefer_decimals => 2, |
|
614
|
|
|
|
|
|
|
date_format => 'ymd', |
|
615
|
|
|
|
|
|
|
}; |
|
616
|
|
|
|
|
|
|
foreach my $elem (['history',\&daily_parse], |
|
617
|
|
|
|
|
|
|
['div', \&daily_parse_div], |
|
618
|
|
|
|
|
|
|
['split', \&daily_parse_split]) { |
|
619
|
|
|
|
|
|
|
my ($events,$parse) = @$elem; |
|
620
|
|
|
|
|
|
|
my $url = "http://query1.finance.yahoo.com/v7/finance/download/" |
|
621
|
|
|
|
|
|
|
. URI::Escape::uri_escape($symbol) |
|
622
|
|
|
|
|
|
|
. "?period1=$lo_timet&period2=$hi_timet&interval=1d&events=$events&crumb=$crumb"; |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
my $resp = App::Chart::Download->get ($url, |
|
625
|
|
|
|
|
|
|
allow_401 => 1, |
|
626
|
|
|
|
|
|
|
allow_404 => 1, |
|
627
|
|
|
|
|
|
|
cookie_jar => $jar, |
|
628
|
|
|
|
|
|
|
); |
|
629
|
|
|
|
|
|
|
if ($resp->code == 401) { |
|
630
|
|
|
|
|
|
|
if (++$crumb_errors >= 2) { die "Yahoo: crumb authorization failed"; } |
|
631
|
|
|
|
|
|
|
App::Chart::Database->write_extra ('', 'yahoo-daily-cookies', undef); |
|
632
|
|
|
|
|
|
|
redo SYMBOL; |
|
633
|
|
|
|
|
|
|
} |
|
634
|
|
|
|
|
|
|
if ($resp->code == 404) { |
|
635
|
|
|
|
|
|
|
print "Yahoo $symbol does not exist"; |
|
636
|
|
|
|
|
|
|
next SYMBOL; |
|
637
|
|
|
|
|
|
|
} |
|
638
|
|
|
|
|
|
|
$parse->($symbol,$resp,$h, $hi_tdate); |
|
639
|
|
|
|
|
|
|
} |
|
640
|
|
|
|
|
|
|
### $h |
|
641
|
|
|
|
|
|
|
App::Chart::Download::write_daily_group ($h); |
|
642
|
|
|
|
|
|
|
} |
|
643
|
|
|
|
|
|
|
} |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
sub daily_parse { |
|
646
|
|
|
|
|
|
|
my ($symbol, $resp, $h, $hi_tdate) = @_; |
|
647
|
|
|
|
|
|
|
my @data = (); |
|
648
|
|
|
|
|
|
|
$h->{'data'} = \@data; |
|
649
|
|
|
|
|
|
|
my $hi_tdate_iso = App::Chart::tdate_to_iso($hi_tdate); |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
my $body = $resp->decoded_content (raise_error => 1); |
|
652
|
|
|
|
|
|
|
my @line_list = App::Chart::Download::split_lines($body); |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
unless ($line_list[0] =~ /^Date,Open,High,Low,Close,Adj Close,Volume/) { |
|
655
|
|
|
|
|
|
|
die "Yahoo: unrecognised daily data headings: " . $line_list[0]; |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
shift @line_list; |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
foreach my $line (@line_list) { |
|
660
|
|
|
|
|
|
|
my ($date, $open, $high, $low, $close, $adj_volume, $volume) |
|
661
|
|
|
|
|
|
|
= split (/,/, $line); |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
$date = daily_date_to_iso ($date); |
|
664
|
|
|
|
|
|
|
if ($date gt $hi_tdate_iso) { |
|
665
|
|
|
|
|
|
|
# Sep 2017: There's a daily data record during the trading day, but |
|
666
|
|
|
|
|
|
|
# want to write the database only at the end of trading. |
|
667
|
|
|
|
|
|
|
next; |
|
668
|
|
|
|
|
|
|
} |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
# Sep 2017 have seen "null,null,null,...", maybe for non-trading days |
|
671
|
|
|
|
|
|
|
foreach my $field ($open, $high, $low, $close, $adj_volume, $volume) { |
|
672
|
|
|
|
|
|
|
if ($field eq 'null') { |
|
673
|
|
|
|
|
|
|
$field = undef; |
|
674
|
|
|
|
|
|
|
} |
|
675
|
|
|
|
|
|
|
} |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
if ($index_pred->match($symbol)) { |
|
678
|
|
|
|
|
|
|
# In the past indexes which not calculated intraday had |
|
679
|
|
|
|
|
|
|
# open==high==low==close and volume==0, eg. ^WIL5. Use the close |
|
680
|
|
|
|
|
|
|
# alone in this case, with the effect of drawing line segments instead |
|
681
|
|
|
|
|
|
|
# of OHLC or Candle figures with no range. |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
if (defined $open && defined $high && defined $low && defined $close |
|
684
|
|
|
|
|
|
|
&& $open == $high && $high == $low && $low == $close && $volume == 0){ |
|
685
|
|
|
|
|
|
|
$open = undef; |
|
686
|
|
|
|
|
|
|
$high = undef; |
|
687
|
|
|
|
|
|
|
$low = undef; |
|
688
|
|
|
|
|
|
|
} |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
} else { |
|
691
|
|
|
|
|
|
|
# In the past shares with no trades had volume==0, |
|
692
|
|
|
|
|
|
|
# open==low==close==bid price, and high==offer price, from some time |
|
693
|
|
|
|
|
|
|
# during the day, maybe the end of day. Zap all the prices in this |
|
694
|
|
|
|
|
|
|
# case. |
|
695
|
|
|
|
|
|
|
# |
|
696
|
|
|
|
|
|
|
# For a public holiday it might be good to zap the volume to undef |
|
697
|
|
|
|
|
|
|
# too, but don't have anything to distinguish holiday, suspension, |
|
698
|
|
|
|
|
|
|
# delisting vs just no trades. |
|
699
|
|
|
|
|
|
|
# |
|
700
|
|
|
|
|
|
|
# On the ASX when shares are suspended the bid/offer can be crossed as |
|
701
|
|
|
|
|
|
|
# usual for pre-open auction, and this gives high<low. For a part-day |
|
702
|
|
|
|
|
|
|
# suspension then can have volume!=0 in this case too. Don't want to |
|
703
|
|
|
|
|
|
|
# show a high<low, so massage high/low to open/close range if the high |
|
704
|
|
|
|
|
|
|
# looks like a crossed offer. |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
if (defined $high && defined $low && $high < $low) { |
|
707
|
|
|
|
|
|
|
$high = App::Chart::max_maybe ($open, $close); |
|
708
|
|
|
|
|
|
|
$low = App::Chart::min_maybe ($open, $close); |
|
709
|
|
|
|
|
|
|
} |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
if (defined $open && defined $low && defined $close && defined $volume |
|
712
|
|
|
|
|
|
|
&& $open == $low && $low == $close && $volume == 0) { |
|
713
|
|
|
|
|
|
|
$open = undef; |
|
714
|
|
|
|
|
|
|
$high = undef; |
|
715
|
|
|
|
|
|
|
$low = undef; |
|
716
|
|
|
|
|
|
|
$close = undef; |
|
717
|
|
|
|
|
|
|
} |
|
718
|
|
|
|
|
|
|
} |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
push @data, { symbol => $symbol, |
|
721
|
|
|
|
|
|
|
date => $date, |
|
722
|
|
|
|
|
|
|
open => crunch_trailing_nines($open), |
|
723
|
|
|
|
|
|
|
high => crunch_trailing_nines($high), |
|
724
|
|
|
|
|
|
|
low => crunch_trailing_nines($low), |
|
725
|
|
|
|
|
|
|
close => crunch_trailing_nines($close), |
|
726
|
|
|
|
|
|
|
volume => $volume }; |
|
727
|
|
|
|
|
|
|
} |
|
728
|
|
|
|
|
|
|
return $h; |
|
729
|
|
|
|
|
|
|
} |
|
730
|
|
|
|
|
|
|
sub daily_parse_div { |
|
731
|
|
|
|
|
|
|
my ($symbol, $resp, $h) = @_; |
|
732
|
|
|
|
|
|
|
my @dividends = (); |
|
733
|
|
|
|
|
|
|
$h->{'dividends'} = \@dividends; |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
my $body = $resp->decoded_content (raise_error => 1); |
|
736
|
|
|
|
|
|
|
my @line_list = App::Chart::Download::split_lines($body); |
|
737
|
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# Date,Dividends |
|
739
|
|
|
|
|
|
|
# 2015-11-04,1.4143 |
|
740
|
|
|
|
|
|
|
# 2016-05-17,1.41428 |
|
741
|
|
|
|
|
|
|
# 2017-05-16,1.4143 |
|
742
|
|
|
|
|
|
|
# 2016-11-03,1.4143 |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
unless ($line_list[0] =~ /^Date,Dividends/) { |
|
745
|
|
|
|
|
|
|
warn "Yahoo: unrecognised dividend headings: " . $line_list[0]; |
|
746
|
|
|
|
|
|
|
return; |
|
747
|
|
|
|
|
|
|
} |
|
748
|
|
|
|
|
|
|
shift @line_list; |
|
749
|
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
foreach my $line (@line_list) { |
|
751
|
|
|
|
|
|
|
my ($date, $amount) = split (/,/, $line); |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
push @dividends, { symbol => $symbol, |
|
754
|
|
|
|
|
|
|
ex_date => daily_date_to_iso ($date), |
|
755
|
|
|
|
|
|
|
amount => $amount }; |
|
756
|
|
|
|
|
|
|
} |
|
757
|
|
|
|
|
|
|
return $h; |
|
758
|
|
|
|
|
|
|
} |
|
759
|
|
|
|
|
|
|
sub daily_parse_split { |
|
760
|
|
|
|
|
|
|
my ($symbol, $resp, $h) = @_; |
|
761
|
|
|
|
|
|
|
my @splits = (); |
|
762
|
|
|
|
|
|
|
$h->{'splits'} = \@splits; |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
my $body = $resp->decoded_content (raise_error => 1); |
|
765
|
|
|
|
|
|
|
my @line_list = App::Chart::Download::split_lines($body); |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
# GXY.AX split so $10 shares become $2 |
|
768
|
|
|
|
|
|
|
# Date,Stock Splits |
|
769
|
|
|
|
|
|
|
# 2017-05-22,1/5 |
|
770
|
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
unless ($line_list[0] =~ /^Date,Stock Splits/) { |
|
772
|
|
|
|
|
|
|
warn "Yahoo: unrecognised split headings: " . $line_list[0]; |
|
773
|
|
|
|
|
|
|
return; |
|
774
|
|
|
|
|
|
|
} |
|
775
|
|
|
|
|
|
|
shift @line_list; |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
foreach my $line (@line_list) { |
|
778
|
|
|
|
|
|
|
my ($date, $ratio) = split (/,/, $line); |
|
779
|
|
|
|
|
|
|
my ($old, $new) = split m{/}, $ratio; |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
push @splits, { symbol => $symbol, |
|
782
|
|
|
|
|
|
|
date => daily_date_to_iso ($date), |
|
783
|
|
|
|
|
|
|
new => $new, |
|
784
|
|
|
|
|
|
|
old => $old }; |
|
785
|
|
|
|
|
|
|
} |
|
786
|
|
|
|
|
|
|
return $h; |
|
787
|
|
|
|
|
|
|
} |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
# $str is a string like "30.299999" |
|
790
|
|
|
|
|
|
|
# Return it with trailing 9s turned into trailing 0s. |
|
791
|
|
|
|
|
|
|
sub crunch_trailing_nines { |
|
792
|
|
|
|
|
|
|
my ($str) = @_; |
|
793
|
|
|
|
|
|
|
if (defined $str) { |
|
794
|
|
|
|
|
|
|
if ($str =~ /(.*)\.(...9+)$/) { |
|
795
|
|
|
|
|
|
|
return decimal_add_low($str,1); |
|
796
|
|
|
|
|
|
|
} |
|
797
|
|
|
|
|
|
|
if ($str =~ /(.*)\.(....*01)$/) { |
|
798
|
|
|
|
|
|
|
return decimal_add_low($str,-1); |
|
799
|
|
|
|
|
|
|
} |
|
800
|
|
|
|
|
|
|
} |
|
801
|
|
|
|
|
|
|
return $str; |
|
802
|
|
|
|
|
|
|
} |
|
803
|
|
|
|
|
|
|
sub decimal_add_low { |
|
804
|
|
|
|
|
|
|
my ($str, $add) = @_; |
|
805
|
|
|
|
|
|
|
$str =~ /(.*)\.(.+)$/ or return $str+$add; |
|
806
|
|
|
|
|
|
|
my $pre = $1; |
|
807
|
|
|
|
|
|
|
my $post = $2; |
|
808
|
|
|
|
|
|
|
$str = $pre * 10**length($post) + $post + $add; |
|
809
|
|
|
|
|
|
|
substr($str, -length($post),0, '.'); |
|
810
|
|
|
|
|
|
|
return $str; |
|
811
|
|
|
|
|
|
|
} |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
# return a hashref |
|
814
|
|
|
|
|
|
|
# { cookies => string, # in format HTTP::Cookies ->as_string() |
|
815
|
|
|
|
|
|
|
# crumb => string |
|
816
|
|
|
|
|
|
|
# } |
|
817
|
|
|
|
|
|
|
# |
|
818
|
|
|
|
|
|
|
# If no such $symbol then return undef; |
|
819
|
|
|
|
|
|
|
# |
|
820
|
|
|
|
|
|
|
# Any $symbol which exists is good enough to get a crumb for all later use. |
|
821
|
|
|
|
|
|
|
# Could hard-code something likely here, but better to go from the symbol |
|
822
|
|
|
|
|
|
|
# which is wanted. |
|
823
|
|
|
|
|
|
|
# |
|
824
|
|
|
|
|
|
|
sub daily_cookie_data { |
|
825
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
826
|
|
|
|
|
|
|
require App::Chart::Pagebits; |
|
827
|
|
|
|
|
|
|
$symbol = URI::Escape::uri_escape($symbol); |
|
828
|
|
|
|
|
|
|
return App::Chart::Pagebits::get |
|
829
|
|
|
|
|
|
|
(name => __('Yahoo daily cookie'), |
|
830
|
|
|
|
|
|
|
url => "https://finance.yahoo.com/quote/$symbol/history?p=$symbol", |
|
831
|
|
|
|
|
|
|
key => 'yahoo-daily-cookies', |
|
832
|
|
|
|
|
|
|
freq_days => 3, |
|
833
|
|
|
|
|
|
|
parse => \&daily_cookie_parse, |
|
834
|
|
|
|
|
|
|
allow_404 => 1); |
|
835
|
|
|
|
|
|
|
} |
|
836
|
|
|
|
|
|
|
sub daily_cookie_parse { |
|
837
|
|
|
|
|
|
|
my ($content, $resp) = @_; |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# script like, with backslash escaping on "\uXXXX" |
|
840
|
|
|
|
|
|
|
#"CrumbStore":{"crumb":"hdDX\u002FHGsZ0Q"} |
|
841
|
|
|
|
|
|
|
# |
|
842
|
|
|
|
|
|
|
$content =~ /"CrumbStore":\{"crumb":"([^"]*)"}/ |
|
843
|
|
|
|
|
|
|
or die "Yahoo daily data: CrumbStore not found"; |
|
844
|
|
|
|
|
|
|
my $crumb = App::Chart::Yahoo::javascript_string_unquote($1); |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# header like |
|
847
|
|
|
|
|
|
|
# Set-Cookie: B=fab5sl9cqn2rd&b=3&s=i3; expires=Sun, 03-Sep-2018 04:56:13 GMT; path=/; domain=.yahoo.com |
|
848
|
|
|
|
|
|
|
# |
|
849
|
|
|
|
|
|
|
# Expiry time is +1 year, but dunno if would really work that long. |
|
850
|
|
|
|
|
|
|
# |
|
851
|
|
|
|
|
|
|
require HTTP::Cookies; |
|
852
|
|
|
|
|
|
|
my $jar = HTTP::Cookies->new; |
|
853
|
|
|
|
|
|
|
$jar->extract_cookies($resp); |
|
854
|
|
|
|
|
|
|
my $cookies_str = $jar->as_string; |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
App::Chart::Download::verbose_message ("Yahoo new crumb $crumb\n" |
|
857
|
|
|
|
|
|
|
. $cookies_str); |
|
858
|
|
|
|
|
|
|
return { crumb => $crumb, |
|
859
|
|
|
|
|
|
|
cookies => $cookies_str }; |
|
860
|
|
|
|
|
|
|
} |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
# return tdate for a date STR from historical data |
|
863
|
|
|
|
|
|
|
# "2005-03-07" AGK.AX seen in jan07, maybe transient |
|
864
|
|
|
|
|
|
|
# "20-Aug-02" past format |
|
865
|
|
|
|
|
|
|
# |
|
866
|
|
|
|
|
|
|
sub daily_date_to_iso { |
|
867
|
|
|
|
|
|
|
my ($str) = @_; |
|
868
|
|
|
|
|
|
|
if ($str =~ /[A-Za-z]/) { |
|
869
|
|
|
|
|
|
|
return App::Chart::Download::Decode_Date_EU_to_iso ($str); # dmy |
|
870
|
|
|
|
|
|
|
} else { |
|
871
|
|
|
|
|
|
|
return $str; |
|
872
|
|
|
|
|
|
|
} |
|
873
|
|
|
|
|
|
|
} |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
# Return seconds since 00:00:00, 1 Jan 1970 GMT. |
|
876
|
|
|
|
|
|
|
sub tdate_to_unix { |
|
877
|
|
|
|
|
|
|
my ($tdate) = @_; |
|
878
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::tdate_to_ymd ($tdate); |
|
879
|
|
|
|
|
|
|
require Time::Local; |
|
880
|
|
|
|
|
|
|
return Time::Local::timegm (0, 0, 0, $day, $month-1, $year-1900); |
|
881
|
|
|
|
|
|
|
} |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
# $str is a string from previous HTTP::Cookies ->as_string() |
|
884
|
|
|
|
|
|
|
# Return a new HTTP::Cookies object with that content. |
|
885
|
|
|
|
|
|
|
sub http_cookies_from_string { |
|
886
|
|
|
|
|
|
|
my ($str) = @_; |
|
887
|
|
|
|
|
|
|
require File::Temp; |
|
888
|
|
|
|
|
|
|
my $fh = File::Temp->new (TEMPLATE => 'chart-XXXXXX', |
|
889
|
|
|
|
|
|
|
TMPDIR => 1); |
|
890
|
|
|
|
|
|
|
print $fh "#LWP-Cookies-1.0\n", $str or die; |
|
891
|
|
|
|
|
|
|
close $fh or die; |
|
892
|
|
|
|
|
|
|
require HTTP::Cookies; |
|
893
|
|
|
|
|
|
|
my $jar = HTTP::Cookies->new; |
|
894
|
|
|
|
|
|
|
$jar->load($fh->filename); |
|
895
|
|
|
|
|
|
|
return $jar; |
|
896
|
|
|
|
|
|
|
} |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
900
|
|
|
|
|
|
|
# stock info |
|
901
|
|
|
|
|
|
|
# |
|
902
|
|
|
|
|
|
|
# Eg. http://download.finance.yahoo.com/d?f=snxc4qr1d&s=TLS.AX |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
App::Chart::DownloadHandler->new |
|
905
|
|
|
|
|
|
|
(name => __('Yahoo info'), |
|
906
|
|
|
|
|
|
|
key => 'Yahoo-info', |
|
907
|
|
|
|
|
|
|
pred => $download_pred, |
|
908
|
|
|
|
|
|
|
proc => \&info_download, |
|
909
|
|
|
|
|
|
|
recheck_days => 7, |
|
910
|
|
|
|
|
|
|
max_symbols => MAX_QUOTES); |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
sub info_download { |
|
913
|
|
|
|
|
|
|
my ($symbol_list) = @_; |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
App::Chart::Download::status |
|
916
|
|
|
|
|
|
|
(__x('Yahoo info {symbolrange}', |
|
917
|
|
|
|
|
|
|
symbolrange => |
|
918
|
|
|
|
|
|
|
App::Chart::Download::symbol_range_string ($symbol_list))); |
|
919
|
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
my $url = 'http://download.finance.yahoo.com/d?f=snxc4qr1d&s=' |
|
921
|
|
|
|
|
|
|
. join (',', map { URI::Escape::uri_escape($_) } @$symbol_list); |
|
922
|
|
|
|
|
|
|
my $resp = App::Chart::Download->get ($url); |
|
923
|
|
|
|
|
|
|
my $h = info_parse($resp); |
|
924
|
|
|
|
|
|
|
$h->{'recheck_list'} = $symbol_list; |
|
925
|
|
|
|
|
|
|
App::Chart::Download::write_daily_group ($h); |
|
926
|
|
|
|
|
|
|
} |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
sub info_parse { |
|
929
|
|
|
|
|
|
|
my ($resp) = @_; |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
my $content = $resp->decoded_content (raise_error => 1); |
|
932
|
|
|
|
|
|
|
if (DEBUG >= 2) { print "Yahoo info:\n$content\n"; } |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
my @info; |
|
935
|
|
|
|
|
|
|
my @dividends; |
|
936
|
|
|
|
|
|
|
my $h = { source => __PACKAGE__, |
|
937
|
|
|
|
|
|
|
info => \@info, |
|
938
|
|
|
|
|
|
|
dividends => \@dividends }; |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
require Text::CSV_XS; |
|
941
|
|
|
|
|
|
|
my $csv = Text::CSV_XS->new; |
|
942
|
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
foreach my $line (App::Chart::Download::split_lines ($content)) { |
|
944
|
|
|
|
|
|
|
$csv->parse($line); |
|
945
|
|
|
|
|
|
|
my ($symbol, $name, $exchange, $currency, $ex_date, $pay_date, $amount) |
|
946
|
|
|
|
|
|
|
= $csv->fields(); |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
$ex_date = quote_parse_div_date ($ex_date); |
|
949
|
|
|
|
|
|
|
$pay_date = quote_parse_div_date ($pay_date); |
|
950
|
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
push @info, { symbol => $symbol, |
|
952
|
|
|
|
|
|
|
name => $name, |
|
953
|
|
|
|
|
|
|
currency => $currency, |
|
954
|
|
|
|
|
|
|
exchange => $exchange }; |
|
955
|
|
|
|
|
|
|
# circa 2015 the "d" dividend amount field is "N/A" when after the |
|
956
|
|
|
|
|
|
|
# dividend payment (with "r1" pay date "N/A" too) |
|
957
|
|
|
|
|
|
|
if ($ex_date && $amount ne 'N/A' && $amount != 0) { |
|
958
|
|
|
|
|
|
|
push @dividends, { symbol => $symbol, |
|
959
|
|
|
|
|
|
|
ex_date => $ex_date, |
|
960
|
|
|
|
|
|
|
pay_date => $pay_date, |
|
961
|
|
|
|
|
|
|
amount => $amount }; |
|
962
|
|
|
|
|
|
|
} |
|
963
|
|
|
|
|
|
|
} |
|
964
|
|
|
|
|
|
|
return $h; |
|
965
|
|
|
|
|
|
|
} |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
969
|
|
|
|
|
|
|
# undo javascript string backslash quoting in STR, per |
|
970
|
|
|
|
|
|
|
# |
|
971
|
|
|
|
|
|
|
# https://developer.mozilla.org/en/JavaScript/Guide/Values,_Variables,_and_Literals#String_Literals |
|
972
|
|
|
|
|
|
|
# |
|
973
|
|
|
|
|
|
|
# Encode::JavaScript::UCS does \u, but not the rest |
|
974
|
|
|
|
|
|
|
# |
|
975
|
|
|
|
|
|
|
# cf Java as such not quite the same: |
|
976
|
|
|
|
|
|
|
# unicode: http://java.sun.com/docs/books/jls/third_edition/html/lexical.html#100850 |
|
977
|
|
|
|
|
|
|
# strings: http://java.sun.com/docs/books/jls/third_edition/html/lexical.html#101089 |
|
978
|
|
|
|
|
|
|
# |
|
979
|
|
|
|
|
|
|
my %javascript_backslash = ('b' => "\b", # backspace |
|
980
|
|
|
|
|
|
|
'f' => "\f", # formfeed |
|
981
|
|
|
|
|
|
|
'n' => "\n", # newline |
|
982
|
|
|
|
|
|
|
'r' => "\r", |
|
983
|
|
|
|
|
|
|
't' => "\t", # tab |
|
984
|
|
|
|
|
|
|
'v' => "\013", # vertical tab |
|
985
|
|
|
|
|
|
|
); |
|
986
|
|
|
|
|
|
|
sub javascript_string_unquote { |
|
987
|
|
|
|
|
|
|
my ($str) = @_; |
|
988
|
|
|
|
|
|
|
$str =~ s{\\(?: |
|
989
|
|
|
|
|
|
|
((?:[0-3]?[0-7])?[0-7]) # $1 \377 octal latin-1 |
|
990
|
|
|
|
|
|
|
|x([0-9a-fA-F]{2}) # $2 \xFF hex latin-1 |
|
991
|
|
|
|
|
|
|
|u([0-9a-fA-F]{4}) # $3 \uFFFF hex unicode |
|
992
|
|
|
|
|
|
|
|(.) # $4 \n etc escapes |
|
993
|
|
|
|
|
|
|
) |
|
994
|
|
|
|
|
|
|
}{ |
|
995
|
|
|
|
|
|
|
(defined $1 ? chr(oct($1)) |
|
996
|
|
|
|
|
|
|
: defined $4 ? ($javascript_backslash{$4} || $4) |
|
997
|
|
|
|
|
|
|
: chr(hex($2||$3))) # \x,\u hex |
|
998
|
|
|
|
|
|
|
}egx; |
|
999
|
|
|
|
|
|
|
return $str; |
|
1000
|
|
|
|
|
|
|
} |
|
1001
|
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1003
|
|
|
|
|
|
|
1; |
|
1004
|
|
|
|
|
|
|
__END__ |