| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# Download functions. |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Copyright 2007, 2008, 2009, 2010, 2011, 2013, 2015, 2016, 2017 Kevin Ryde |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# This file is part of Chart. |
|
6
|
|
|
|
|
|
|
# |
|
7
|
|
|
|
|
|
|
# Chart is free software; you can redistribute it and/or modify it under the |
|
8
|
|
|
|
|
|
|
# terms of the GNU General Public License as published by the Free Software |
|
9
|
|
|
|
|
|
|
# Foundation; either version 3, or (at your option) any later version. |
|
10
|
|
|
|
|
|
|
# |
|
11
|
|
|
|
|
|
|
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY |
|
12
|
|
|
|
|
|
|
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
|
13
|
|
|
|
|
|
|
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
|
14
|
|
|
|
|
|
|
# details. |
|
15
|
|
|
|
|
|
|
# |
|
16
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License along |
|
17
|
|
|
|
|
|
|
# with Chart. If not, see <http://www.gnu.org/licenses/>. |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
package App::Chart::Download; |
|
20
|
2
|
|
|
2
|
|
543
|
use 5.010; |
|
|
2
|
|
|
|
|
6
|
|
|
21
|
2
|
|
|
2
|
|
8
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
34
|
|
|
22
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
48
|
|
|
23
|
2
|
|
|
2
|
|
8
|
use Carp 'carp','croak'; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
86
|
|
|
24
|
2
|
|
|
2
|
|
442
|
use Date::Calc; |
|
|
2
|
|
|
|
|
8188
|
|
|
|
2
|
|
|
|
|
70
|
|
|
25
|
2
|
|
|
2
|
|
10
|
use List::Util qw(min max); |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
93
|
|
|
26
|
2
|
|
|
2
|
|
333
|
use List::MoreUtils; |
|
|
2
|
|
|
|
|
8677
|
|
|
|
2
|
|
|
|
|
20
|
|
|
27
|
2
|
|
|
2
|
|
2151
|
use Regexp::Common 'whitespace'; |
|
|
2
|
|
|
|
|
4006
|
|
|
|
2
|
|
|
|
|
7
|
|
|
28
|
2
|
|
|
2
|
|
2036
|
use Locale::TextDomain ('App-Chart'); |
|
|
2
|
|
|
|
|
16371
|
|
|
|
2
|
|
|
|
|
11
|
|
|
29
|
|
|
|
|
|
|
|
|
30
|
2
|
|
|
2
|
|
5751
|
use PerlIO::via::EscStatus; |
|
|
2
|
|
|
|
|
21320
|
|
|
|
2
|
|
|
|
|
71
|
|
|
31
|
2
|
|
|
2
|
|
497
|
use Tie::TZ; |
|
|
2
|
|
|
|
|
886
|
|
|
|
2
|
|
|
|
|
83
|
|
|
32
|
|
|
|
|
|
|
|
|
33
|
2
|
|
|
2
|
|
847
|
use App::Chart; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
use App::Chart::Database; |
|
35
|
|
|
|
|
|
|
use App::Chart::DBI; |
|
36
|
|
|
|
|
|
|
use App::Chart::TZ; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
|
39
|
|
|
|
|
|
|
# use Smart::Comments; |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use constant DEBUG => 0; |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub get { |
|
46
|
|
|
|
|
|
|
my ($class, $url, %options) = @_; |
|
47
|
|
|
|
|
|
|
### Download get(): $url |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# URI object becomes string |
|
50
|
|
|
|
|
|
|
$url = "$url"; |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my $ua = $options{'ua'} || do { require App::Chart::UserAgent; |
|
53
|
|
|
|
|
|
|
App::Chart::UserAgent->instance }; |
|
54
|
|
|
|
|
|
|
$ua->cookie_jar ($options{'cookie_jar'}); # undef for none |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
require HTTP::Request; |
|
57
|
|
|
|
|
|
|
my $method = $options{'method'} || 'GET'; |
|
58
|
|
|
|
|
|
|
my @headers = (Referer => $options{'referer'}); |
|
59
|
|
|
|
|
|
|
my $data = $options{'data'}; |
|
60
|
|
|
|
|
|
|
if (defined $data) { |
|
61
|
|
|
|
|
|
|
push @headers, 'Content-Type' => 'application/x-www-form-urlencoded'; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
my $req = HTTP::Request->new ($method, $url, \@headers, $data); |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# possible override |
|
66
|
|
|
|
|
|
|
if (my $user_agent = $options{'user_agent'}) { |
|
67
|
|
|
|
|
|
|
$req->user_agent($user_agent); |
|
68
|
|
|
|
|
|
|
} |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
my $etag = $options{'etag'}; |
|
71
|
|
|
|
|
|
|
my $lastmod = $options{'last_modified'}; |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
if (my $key = $options{'url_tags_key'}) { |
|
74
|
|
|
|
|
|
|
my $symbol = $options{'symbol'}; |
|
75
|
|
|
|
|
|
|
my $prev_url = App::Chart::Database->read_extra($symbol,"$key-URL"); |
|
76
|
|
|
|
|
|
|
if (defined $prev_url && $url eq $prev_url) { |
|
77
|
|
|
|
|
|
|
$etag = App::Chart::Database->read_extra($symbol,"$key-ETag"); |
|
78
|
|
|
|
|
|
|
$lastmod = App::Chart::Database->read_extra($symbol,"$key-Last-Modified"); |
|
79
|
|
|
|
|
|
|
} |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
if ($etag) { $req->header ('If-None-Match' => $etag); } |
|
83
|
|
|
|
|
|
|
if ($lastmod) { $req->header ('If-Modified-Since' => $lastmod); } |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
$ua->prepare_request ($req); |
|
86
|
|
|
|
|
|
|
if (DEBUG) { print $req->as_string; } |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
if ($App::Chart::option{'verbose'} || DEBUG) { |
|
89
|
|
|
|
|
|
|
if ($App::Chart::option{'verbose'} >= 2 || DEBUG >= 2) { |
|
90
|
|
|
|
|
|
|
print $req->as_string; |
|
91
|
|
|
|
|
|
|
} else { |
|
92
|
|
|
|
|
|
|
print "$method $url\n"; |
|
93
|
|
|
|
|
|
|
} |
|
94
|
|
|
|
|
|
|
if (defined $data) { |
|
95
|
|
|
|
|
|
|
print "$data\n"; |
|
96
|
|
|
|
|
|
|
} |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $resp = $ua->request ($req); |
|
100
|
|
|
|
|
|
|
if (DEBUG) { print $resp->status_line,"\n"; |
|
101
|
|
|
|
|
|
|
print $resp->headers->as_string,"\n"; } |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# internal message from LWP when a keep-alive has missed the boat |
|
104
|
|
|
|
|
|
|
if ($resp->status_line =~ /500 Server closed connection/i) { |
|
105
|
|
|
|
|
|
|
substatus (__('retry')); |
|
106
|
|
|
|
|
|
|
$resp = $ua->request ($req); |
|
107
|
|
|
|
|
|
|
if (DEBUG) { print $resp->status_line,"\n"; |
|
108
|
|
|
|
|
|
|
print $resp->headers->as_string,"\n"; } |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
if ($resp->is_success |
|
112
|
|
|
|
|
|
|
|| ($options{'allow_401'} && $resp->code == 401) |
|
113
|
|
|
|
|
|
|
|| ($options{'allow_404'} && $resp->code == 404) |
|
114
|
|
|
|
|
|
|
|| (($etag || $lastmod) && $resp->code == 304)) { |
|
115
|
|
|
|
|
|
|
substatus (__('processing')); |
|
116
|
|
|
|
|
|
|
return $resp; |
|
117
|
|
|
|
|
|
|
} else { |
|
118
|
|
|
|
|
|
|
croak "Cannot download $url\n",$resp->status_line,"\n"; |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
} |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $last_status = ''; # without substatus addition |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub download_message { |
|
127
|
|
|
|
|
|
|
print join (' ',@_),"\n"; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
sub verbose_message { |
|
130
|
|
|
|
|
|
|
if ($App::Chart::option{'verbose'}) { |
|
131
|
|
|
|
|
|
|
print join (' ',@_),"\n"; |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
} |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub status { |
|
136
|
|
|
|
|
|
|
my $str = join (' ', @_); |
|
137
|
|
|
|
|
|
|
$last_status = $str; |
|
138
|
|
|
|
|
|
|
PerlIO::via::EscStatus::print_status ($str); |
|
139
|
|
|
|
|
|
|
} |
|
140
|
|
|
|
|
|
|
sub substatus { |
|
141
|
|
|
|
|
|
|
my ($str) = @_; |
|
142
|
|
|
|
|
|
|
if ($str) { |
|
143
|
|
|
|
|
|
|
PerlIO::via::EscStatus::print_status ($last_status, ' [', $str, ']'); |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub split_lines { |
|
150
|
|
|
|
|
|
|
my ($str) = @_; |
|
151
|
|
|
|
|
|
|
my @lines = split (/[\r\n]+/, $str); # LF or CRLF |
|
152
|
|
|
|
|
|
|
foreach (@lines) { $_ =~ s/[ \t]+$// } # trailing whitespace |
|
153
|
|
|
|
|
|
|
return grep {$_ ne ''} @lines; # no blanks |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub trim_decimals { |
|
159
|
|
|
|
|
|
|
my ($str, $want_decimals) = @_; |
|
160
|
|
|
|
|
|
|
if ($str && $str =~ /(.*\.[0-9]{$want_decimals}[0-9]*?)0+$/) { |
|
161
|
|
|
|
|
|
|
return $1; |
|
162
|
|
|
|
|
|
|
} else { |
|
163
|
|
|
|
|
|
|
return $str; |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub str_is_zero { |
|
170
|
|
|
|
|
|
|
my ($str) = @_; |
|
171
|
|
|
|
|
|
|
return ($str =~ /^0+(\.0*)?$|^0*(\.0+)$/ ? 1 : 0); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub cents_to_dollars { |
|
178
|
|
|
|
|
|
|
my ($str) = @_; |
|
179
|
|
|
|
|
|
|
$str =~ /^([^.]*)(\.(.*))?$/ |
|
180
|
|
|
|
|
|
|
or croak "cents_to_dollars(): bad string: \"$str\""; |
|
181
|
|
|
|
|
|
|
my $int = $1; |
|
182
|
|
|
|
|
|
|
my $frac = (defined $3 ? $3 : ''); |
|
183
|
|
|
|
|
|
|
if (length ($int) < 3) { |
|
184
|
|
|
|
|
|
|
$int = sprintf ('%03s', $int); |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
return substr ($int, 0, length($int)-2) . '.' . |
|
187
|
|
|
|
|
|
|
substr ($int, length($int)-2) . $frac; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub month_to_nearest_year { |
|
194
|
|
|
|
|
|
|
my ($target_month) = @_; |
|
195
|
|
|
|
|
|
|
my ($year, $month, $day) = Date::Calc::Today(); |
|
196
|
|
|
|
|
|
|
$month --; # 0=January |
|
197
|
|
|
|
|
|
|
$target_month --; |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
my $diff = $target_month - $month; |
|
200
|
|
|
|
|
|
|
$diff += 5; |
|
201
|
|
|
|
|
|
|
$diff %= 12; |
|
202
|
|
|
|
|
|
|
$diff -= 5; # now range -5 to +6 |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# applying $diff makes $month == $target_month modulo 12, |
|
205
|
|
|
|
|
|
|
# but $month<0 is last year, 0 to 11 this year, >= 12 next year |
|
206
|
|
|
|
|
|
|
$month += $diff; |
|
207
|
|
|
|
|
|
|
return $year + ($month < 0 ? -1 : $month < 12 ? 0 : 1); |
|
208
|
|
|
|
|
|
|
} |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub Decode_Date_EU_to_iso { |
|
214
|
|
|
|
|
|
|
my ($str, $noerror) = @_; |
|
215
|
|
|
|
|
|
|
my ($year, $month, $day) = Date::Calc::Decode_Date_EU ($str); |
|
216
|
|
|
|
|
|
|
if (! (defined $year && defined $month && defined $day)) { |
|
217
|
|
|
|
|
|
|
if ($noerror) { |
|
218
|
|
|
|
|
|
|
return undef; |
|
219
|
|
|
|
|
|
|
} else { |
|
220
|
|
|
|
|
|
|
croak "Decode_Date_EU_to_iso: unrecognised date \"$str\"\n"; |
|
221
|
|
|
|
|
|
|
} |
|
222
|
|
|
|
|
|
|
} |
|
223
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year, $month, $day); |
|
224
|
|
|
|
|
|
|
} |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub Decode_Date_US_to_iso { |
|
227
|
|
|
|
|
|
|
my ($str) = @_; |
|
228
|
|
|
|
|
|
|
my ($year, $month, $day) = Date::Calc::Decode_Date_US ($str); |
|
229
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year, $month, $day); |
|
230
|
|
|
|
|
|
|
} |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub Decode_Date_YMD { |
|
235
|
|
|
|
|
|
|
my ($str) = @_; |
|
236
|
|
|
|
|
|
|
($str =~ m{^ # 6 or 8 digits are yyyymmdd or yymmdd |
|
237
|
|
|
|
|
|
|
["'[:space:]]* |
|
238
|
|
|
|
|
|
|
(\d{2,4}) # $1 year |
|
239
|
|
|
|
|
|
|
((\d{2})|([A-Za-z]+)) # $3 numeric month, $4 alpha month |
|
240
|
|
|
|
|
|
|
(\d{2}) # $5 day |
|
241
|
|
|
|
|
|
|
["'[:space:]]* |
|
242
|
|
|
|
|
|
|
$}x) |
|
243
|
|
|
|
|
|
|
or |
|
244
|
|
|
|
|
|
|
($str =~ m{^ |
|
245
|
|
|
|
|
|
|
["'[:space:]]* |
|
246
|
|
|
|
|
|
|
(\d{2,4}) # $1 year |
|
247
|
|
|
|
|
|
|
[-_/:.[:space:]]* |
|
248
|
|
|
|
|
|
|
((\d{1,2})|([A-Za-z]+)) # $3 numeric month, $4 alpha month |
|
249
|
|
|
|
|
|
|
[-_/:.[:space:]]* |
|
250
|
|
|
|
|
|
|
(\d{1,2}) # $5 day |
|
251
|
|
|
|
|
|
|
["'[:space:]]* |
|
252
|
|
|
|
|
|
|
$}x) |
|
253
|
|
|
|
|
|
|
or return; |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $year = $1; |
|
256
|
|
|
|
|
|
|
my $num_month = $3; |
|
257
|
|
|
|
|
|
|
my $alpha_month = $4, |
|
258
|
|
|
|
|
|
|
my $day = $5; |
|
259
|
|
|
|
|
|
|
my $month = $num_month || Date::Calc::Decode_Month ($alpha_month); |
|
260
|
|
|
|
|
|
|
$year = Date::Calc::Moving_Window ($year); |
|
261
|
|
|
|
|
|
|
return ($year, $month, $day); |
|
262
|
|
|
|
|
|
|
} |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub Decode_Date_YMD_to_iso { |
|
265
|
|
|
|
|
|
|
my ($str) = @_; |
|
266
|
|
|
|
|
|
|
my ($year, $month, $day) = Decode_Date_YMD ($str); |
|
267
|
|
|
|
|
|
|
if (! defined $year || ! defined $month || ! defined $day |
|
268
|
|
|
|
|
|
|
|| ! Date::Calc::check_date ($year, $month, $day)) { |
|
269
|
|
|
|
|
|
|
croak "Decode_Date_YMD_to_iso: invalid date \"$str\"\n"; |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year, $month, $day); |
|
272
|
|
|
|
|
|
|
} |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub date_parse_to_iso { |
|
278
|
|
|
|
|
|
|
my ($str) = @_; |
|
279
|
|
|
|
|
|
|
require Date::Parse; |
|
280
|
|
|
|
|
|
|
my ($ss,$mm,$hh,$day,$month,$year,$zone) = Date::Parse::strptime ($str); |
|
281
|
|
|
|
|
|
|
if (! defined ($day) || ! defined ($month) || ! defined ($year)) { |
|
282
|
|
|
|
|
|
|
croak "date_parse_to_iso: unrecognised date \"$str\"\n"; |
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year + 1900, $month + 1, $day); |
|
285
|
|
|
|
|
|
|
} |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# $h is a hash of share prices |
|
290
|
|
|
|
|
|
|
# data => [ { symbol=>$str, |
|
291
|
|
|
|
|
|
|
# date => $str, |
|
292
|
|
|
|
|
|
|
# open => $price, |
|
293
|
|
|
|
|
|
|
# high => $price, |
|
294
|
|
|
|
|
|
|
# low => $price, |
|
295
|
|
|
|
|
|
|
# close => $price, |
|
296
|
|
|
|
|
|
|
# volume => $number, |
|
297
|
|
|
|
|
|
|
# openint => $number, |
|
298
|
|
|
|
|
|
|
# }, |
|
299
|
|
|
|
|
|
|
# ... |
|
300
|
|
|
|
|
|
|
# ] |
|
301
|
|
|
|
|
|
|
# dividends => [ { symbol => $str, |
|
302
|
|
|
|
|
|
|
# ex_date => $date, |
|
303
|
|
|
|
|
|
|
# record_date => $date, |
|
304
|
|
|
|
|
|
|
# pay_date => $date, |
|
305
|
|
|
|
|
|
|
# type => $str, |
|
306
|
|
|
|
|
|
|
# amount => $price, |
|
307
|
|
|
|
|
|
|
# imputation => $price, |
|
308
|
|
|
|
|
|
|
# qualifier => $str, |
|
309
|
|
|
|
|
|
|
# note => $str, |
|
310
|
|
|
|
|
|
|
# }, |
|
311
|
|
|
|
|
|
|
# ... |
|
312
|
|
|
|
|
|
|
# ], |
|
313
|
|
|
|
|
|
|
# write it as daily data in the database |
|
314
|
|
|
|
|
|
|
sub write_daily_group { |
|
315
|
|
|
|
|
|
|
my ($h) = @_; |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
crunch_h ($h); |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $prefer_decimals = $h->{'prefer_decimals'}; |
|
320
|
|
|
|
|
|
|
my $database_symbols_hash = App::Chart::Database::database_symbols_hash(); |
|
321
|
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
my %decimals; |
|
323
|
|
|
|
|
|
|
my %data_changed; |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
substatus (__('writing database')); |
|
326
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
327
|
|
|
|
|
|
|
App::Chart::Database::call_with_transaction |
|
328
|
|
|
|
|
|
|
($dbh, sub { |
|
329
|
|
|
|
|
|
|
if ($h->{'cost_key'}) { |
|
330
|
|
|
|
|
|
|
require App::Chart::DownloadCost; |
|
331
|
|
|
|
|
|
|
App::Chart::DownloadCost::cost_store_h ($h); |
|
332
|
|
|
|
|
|
|
} |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
my %symbol_hash; |
|
335
|
|
|
|
|
|
|
{ |
|
336
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached |
|
337
|
|
|
|
|
|
|
('INSERT OR REPLACE INTO daily |
|
338
|
|
|
|
|
|
|
(symbol, date, open, high, low, close, volume, openint) |
|
339
|
|
|
|
|
|
|
VALUES (?,?,?,?,?,?,?,?)'); |
|
340
|
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
342
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
343
|
|
|
|
|
|
|
next unless exists $database_symbols_hash->{$symbol}; |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
if (defined $prefer_decimals) { |
|
346
|
|
|
|
|
|
|
$decimals{$symbol} = $prefer_decimals; |
|
347
|
|
|
|
|
|
|
} |
|
348
|
|
|
|
|
|
|
$data_changed{$symbol} = 1; |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$sth->execute($symbol, |
|
351
|
|
|
|
|
|
|
$data->{'date'}, |
|
352
|
|
|
|
|
|
|
$data->{'open'}, |
|
353
|
|
|
|
|
|
|
$data->{'high'}, |
|
354
|
|
|
|
|
|
|
$data->{'low'}, |
|
355
|
|
|
|
|
|
|
$data->{'close'}, |
|
356
|
|
|
|
|
|
|
$data->{'volume'}, |
|
357
|
|
|
|
|
|
|
$data->{'openint'}); |
|
358
|
|
|
|
|
|
|
$sth->finish; |
|
359
|
|
|
|
|
|
|
} |
|
360
|
|
|
|
|
|
|
} |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
foreach my $dividend (@{$h->{'dividends'}}) { |
|
363
|
|
|
|
|
|
|
my $symbol = $dividend->{'symbol'} |
|
364
|
|
|
|
|
|
|
or croak "write_daily_group: missing symbol in dividend record"; |
|
365
|
|
|
|
|
|
|
next unless exists $database_symbols_hash->{$symbol}; |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
my $ex_date = $dividend->{'ex_date'}; |
|
368
|
|
|
|
|
|
|
my $record_date = $dividend->{'record_date'}; |
|
369
|
|
|
|
|
|
|
my $pay_date = $dividend->{'pay_date'}; |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
my $type = $dividend->{'type'} || ''; |
|
372
|
|
|
|
|
|
|
my $amount = $dividend->{'amount'}; |
|
373
|
|
|
|
|
|
|
my $imputation = $dividend->{'imputation'}; |
|
374
|
|
|
|
|
|
|
my $qualifier = crunch_empty_undef ($dividend->{'qualifier'}); |
|
375
|
|
|
|
|
|
|
my $note = crunch_empty_undef ($dividend->{'note'}); |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
my $old_qualifier = App::Chart::DBI->read_single |
|
378
|
|
|
|
|
|
|
('SELECT qualifier FROM dividend WHERE symbol=? AND ex_date=? AND type=?', $symbol, $ex_date, $type); |
|
379
|
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached |
|
381
|
|
|
|
|
|
|
('INSERT OR REPLACE INTO dividend |
|
382
|
|
|
|
|
|
|
(symbol, ex_date, record_date, pay_date, |
|
383
|
|
|
|
|
|
|
type, amount, imputation, qualifier, note) |
|
384
|
|
|
|
|
|
|
VALUES (?,?,?,?, ?,?,?,?,?)'); |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
$sth->execute ($symbol, $ex_date, $record_date, $pay_date, |
|
387
|
|
|
|
|
|
|
$type, $amount, $imputation, $qualifier, $note); |
|
388
|
|
|
|
|
|
|
$sth->finish; |
|
389
|
|
|
|
|
|
|
$data_changed{$symbol} = 1; |
|
390
|
|
|
|
|
|
|
} |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
foreach my $split (@{$h->{'splits'}}) { |
|
393
|
|
|
|
|
|
|
my $symbol = $split->{'symbol'} |
|
394
|
|
|
|
|
|
|
or croak "write_daily_group: missing symbol in split record"; |
|
395
|
|
|
|
|
|
|
next unless exists $database_symbols_hash->{$symbol}; |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
my $date = $split->{'date'}; |
|
398
|
|
|
|
|
|
|
my $new = crunch_number ($split->{'new'}); |
|
399
|
|
|
|
|
|
|
my $old = crunch_number ($split->{'old'}); |
|
400
|
|
|
|
|
|
|
my $note = crunch_empty_undef ($split->{'note'}); |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached |
|
403
|
|
|
|
|
|
|
('INSERT OR REPLACE INTO split (symbol, date, new, old, note) |
|
404
|
|
|
|
|
|
|
VALUES (?,?,?,?,?)'); |
|
405
|
|
|
|
|
|
|
$sth->execute ($symbol, $date, $new, $old, $note); |
|
406
|
|
|
|
|
|
|
$sth->finish; |
|
407
|
|
|
|
|
|
|
$data_changed{$symbol} = 1; |
|
408
|
|
|
|
|
|
|
} |
|
409
|
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
if (my $names = $h->{'names'}) { |
|
411
|
|
|
|
|
|
|
while (my ($symbol, $name) = each %$names) { |
|
412
|
|
|
|
|
|
|
if (defined $name) { |
|
413
|
|
|
|
|
|
|
$data_changed{$symbol} |= set_symbol_name ($symbol, $name); |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
} |
|
416
|
|
|
|
|
|
|
} |
|
417
|
|
|
|
|
|
|
if (my $currencies = $h->{'currencies'}) { |
|
418
|
|
|
|
|
|
|
while (my ($symbol, $currency) = each %$currencies) { |
|
419
|
|
|
|
|
|
|
if (defined $currency) { |
|
420
|
|
|
|
|
|
|
$data_changed{$symbol} |= set_currency ($symbol, $currency); |
|
421
|
|
|
|
|
|
|
} |
|
422
|
|
|
|
|
|
|
} |
|
423
|
|
|
|
|
|
|
} |
|
424
|
|
|
|
|
|
|
if (my $isins = $h->{'isins'}) { |
|
425
|
|
|
|
|
|
|
while (my ($symbol, $isin) = each %$isins) { |
|
426
|
|
|
|
|
|
|
if (defined $isin) { |
|
427
|
|
|
|
|
|
|
$data_changed{$symbol} |= set_isin ($symbol, $isin); |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
if (my $exchanges = $h->{'exchanges'}) { |
|
432
|
|
|
|
|
|
|
while (my ($symbol, $exchange) = each %$exchanges) { |
|
433
|
|
|
|
|
|
|
if (defined $exchange) { |
|
434
|
|
|
|
|
|
|
$data_changed{$symbol} |= set_exchange ($symbol, $exchange); |
|
435
|
|
|
|
|
|
|
} |
|
436
|
|
|
|
|
|
|
} |
|
437
|
|
|
|
|
|
|
} |
|
438
|
|
|
|
|
|
|
while (my ($symbol, $decimals) = each %decimals) { |
|
439
|
|
|
|
|
|
|
if (defined $decimals) { |
|
440
|
|
|
|
|
|
|
$data_changed{$symbol} |= set_decimals ($symbol, $decimals); |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
} |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
my $symbol_list = [ keys %data_changed ]; |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
if (my $key = $h->{'url_tags_key'}) { |
|
447
|
|
|
|
|
|
|
my $resp = $h->{'resp'}; |
|
448
|
|
|
|
|
|
|
foreach my $symbol (@$symbol_list) { |
|
449
|
|
|
|
|
|
|
my $url = (defined $resp ? $resp->request->uri : undef); |
|
450
|
|
|
|
|
|
|
my $etag = (defined $resp ? scalar $resp->header('ETag') : undef); |
|
451
|
|
|
|
|
|
|
my $last_modified =(defined $resp ? $resp->last_modified : undef); |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
App::Chart::Database->write_extra |
|
454
|
|
|
|
|
|
|
($symbol, "$key-URL", "$url"); # stringize URI object |
|
455
|
|
|
|
|
|
|
App::Chart::Database->write_extra |
|
456
|
|
|
|
|
|
|
($symbol, "$key-ETag", $etag); |
|
457
|
|
|
|
|
|
|
App::Chart::Database->write_extra |
|
458
|
|
|
|
|
|
|
($symbol, "$key-Last-Modified", $last_modified); |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
if (my $key = $h->{'copyright_key'}) { |
|
463
|
|
|
|
|
|
|
foreach my $symbol (@$symbol_list) { |
|
464
|
|
|
|
|
|
|
App::Chart::Database->write_extra |
|
465
|
|
|
|
|
|
|
($symbol, $key, $h->{'copyright'}); |
|
466
|
|
|
|
|
|
|
} |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
my $timestamp = timestamp_now(); |
|
470
|
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
if (my $key = $h->{'recheck_key'}) { |
|
472
|
|
|
|
|
|
|
my @recheck_list; |
|
473
|
|
|
|
|
|
|
if (my $l = $h->{'recheck_list'}) { |
|
474
|
|
|
|
|
|
|
@recheck_list = @$l; |
|
475
|
|
|
|
|
|
|
} |
|
476
|
|
|
|
|
|
|
if (my $pred = $h->{'recheck_pred'}) { |
|
477
|
|
|
|
|
|
|
push @recheck_list, |
|
478
|
|
|
|
|
|
|
grep { $pred->match($_) } keys %$database_symbols_hash; |
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
if (DEBUG) { print "Recheck write ",join(' ',@recheck_list),"\n"; } |
|
481
|
|
|
|
|
|
|
foreach my $symbol (@recheck_list) { |
|
482
|
|
|
|
|
|
|
App::Chart::Database->write_extra ($symbol, $key, $timestamp); |
|
483
|
|
|
|
|
|
|
} |
|
484
|
|
|
|
|
|
|
} |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
if ($h->{'last_download'}) { |
|
487
|
|
|
|
|
|
|
foreach my $symbol (keys %data_changed) { |
|
488
|
|
|
|
|
|
|
App::Chart::Database->write_extra ($symbol, 'last-download', |
|
489
|
|
|
|
|
|
|
$timestamp); |
|
490
|
|
|
|
|
|
|
} |
|
491
|
|
|
|
|
|
|
consider_historical ($symbol_list); |
|
492
|
|
|
|
|
|
|
} |
|
493
|
|
|
|
|
|
|
consider_latest_from_daily ($h, $database_symbols_hash); |
|
494
|
|
|
|
|
|
|
}); |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
### data_changed: %data_changed |
|
497
|
|
|
|
|
|
|
App::Chart::chart_dirbroadcast()->send ('data-changed', \%data_changed); |
|
498
|
|
|
|
|
|
|
} |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
sub consider_historical { |
|
501
|
|
|
|
|
|
|
my ($symbol_list) = @_; |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
my $all_list; |
|
504
|
|
|
|
|
|
|
my $historical_list; |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
foreach my $symbol (@$symbol_list) { |
|
507
|
|
|
|
|
|
|
if (App::Chart::Database->symbol_is_historical ($symbol)) { |
|
508
|
|
|
|
|
|
|
next; # already marked |
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
my $reason = want_historical($symbol) // next; |
|
511
|
|
|
|
|
|
|
download_message ($reason); |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
514
|
|
|
|
|
|
|
$dbh->do ('UPDATE info SET historical=1 WHERE symbol=?', |
|
515
|
|
|
|
|
|
|
{}, $symbol); |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
require App::Chart::Gtk2::Symlist; |
|
518
|
|
|
|
|
|
|
$all_list ||= App::Chart::Gtk2::Symlist::All->instance; |
|
519
|
|
|
|
|
|
|
$historical_list ||= App::Chart::Gtk2::Symlist::Historical->instance; |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
$all_list->delete_symbol ($symbol); |
|
522
|
|
|
|
|
|
|
$historical_list->insert_symbol ($symbol); |
|
523
|
|
|
|
|
|
|
} |
|
524
|
|
|
|
|
|
|
} |
|
525
|
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# return true if $symbol should be marked historical, meaning it has had no |
|
527
|
|
|
|
|
|
|
# new daily data for a long time |
|
528
|
|
|
|
|
|
|
# |
|
529
|
|
|
|
|
|
|
sub want_historical { |
|
530
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
531
|
|
|
|
|
|
|
my $last_download_timestamp |
|
532
|
|
|
|
|
|
|
= App::Chart::Database->read_extra ($symbol, 'last-download') |
|
533
|
|
|
|
|
|
|
// return undef; # no download attempted, not historical |
|
534
|
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
my $date = App::Chart::DBI->read_single |
|
536
|
|
|
|
|
|
|
('SELECT date FROM daily WHERE (symbol=?) AND (close NOTNULL) |
|
537
|
|
|
|
|
|
|
ORDER BY date DESC LIMIT 1', |
|
538
|
|
|
|
|
|
|
$symbol); |
|
539
|
|
|
|
|
|
|
if (! defined $date) { |
|
540
|
|
|
|
|
|
|
return __x('{symbol} no data at all, marked historical', |
|
541
|
|
|
|
|
|
|
symbol => $symbol); |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
my $days = iso_timestamp_days_ago ($date, $last_download_timestamp); |
|
544
|
|
|
|
|
|
|
if ($days > 21) { |
|
545
|
|
|
|
|
|
|
return __x('{symbol} no data for {days} days, marked historical', |
|
546
|
|
|
|
|
|
|
days => $days, |
|
547
|
|
|
|
|
|
|
symbol => $symbol); |
|
548
|
|
|
|
|
|
|
} |
|
549
|
|
|
|
|
|
|
return undef; |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
sub iso_timestamp_days_ago { |
|
553
|
|
|
|
|
|
|
my ($iso, $prev_timestamp) = @_; |
|
554
|
|
|
|
|
|
|
my ($prev_year,$prev_month,$prev_day) = timestamp_to_ymdhms($prev_timestamp); |
|
555
|
|
|
|
|
|
|
return Date::Calc::Delta_Days (App::Chart::iso_to_ymd($iso), |
|
556
|
|
|
|
|
|
|
$prev_year, $prev_month, $prev_day); |
|
557
|
|
|
|
|
|
|
} |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub consider_latest_from_daily { |
|
560
|
|
|
|
|
|
|
my ($h) = @_; |
|
561
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
562
|
|
|
|
|
|
|
my %latest_changed; |
|
563
|
|
|
|
|
|
|
my $timestamp; |
|
564
|
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
my $database_symbols_hash = App::Chart::Database::database_symbols_hash(); |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# find the newest and second newest data record of each symbol |
|
568
|
|
|
|
|
|
|
my %data_newest; |
|
569
|
|
|
|
|
|
|
my %data_second; |
|
570
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
571
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
572
|
|
|
|
|
|
|
if ($data->{'date'} ge ($data_newest{$symbol}->{'date'} // '')) { |
|
573
|
|
|
|
|
|
|
$data_second{$symbol} = $data_newest{$symbol}; |
|
574
|
|
|
|
|
|
|
$data_newest{$symbol} = $data; |
|
575
|
|
|
|
|
|
|
} elsif ($data->{'date'} ge ($data_second{$symbol}->{'date'} // '')) { |
|
576
|
|
|
|
|
|
|
$data_second{$symbol} = $data; |
|
577
|
|
|
|
|
|
|
} |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
foreach my $symbol (keys %data_newest) { |
|
581
|
|
|
|
|
|
|
my $newest = $data_newest{$symbol}; |
|
582
|
|
|
|
|
|
|
my $date = $newest->{'date'}; |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
# For symbols in the database, if newest daily is >= latest quote then |
|
585
|
|
|
|
|
|
|
# delete that quote in order to prefer the daily data in the database. |
|
586
|
|
|
|
|
|
|
if (exists $database_symbols_hash->{$symbol}) { |
|
587
|
|
|
|
|
|
|
my $latest_delete_sth = $dbh->prepare_cached |
|
588
|
|
|
|
|
|
|
('DELETE FROM latest WHERE symbol=? AND quote_date < ?'); |
|
589
|
|
|
|
|
|
|
if ($latest_delete_sth->execute ($symbol, $date)) { |
|
590
|
|
|
|
|
|
|
$latest_changed{$symbol} = 1; |
|
591
|
|
|
|
|
|
|
} |
|
592
|
|
|
|
|
|
|
next; |
|
593
|
|
|
|
|
|
|
} |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# For symbols not in the database, if the newest daily is >= latest quote |
|
596
|
|
|
|
|
|
|
# then replace that quote with the daily. |
|
597
|
|
|
|
|
|
|
# |
|
598
|
|
|
|
|
|
|
# Times in the latest record are not considered, so it's possible a |
|
599
|
|
|
|
|
|
|
# quote taken after close of trading will be deleted or overwritten. |
|
600
|
|
|
|
|
|
|
# Would want something in the latest to say it's after the close ... |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my $latest_get_sth = $dbh->prepare_cached |
|
603
|
|
|
|
|
|
|
('SELECT last_date, name FROM latest WHERE symbol=?'); |
|
604
|
|
|
|
|
|
|
my ($last_date, $name, $dividend) |
|
605
|
|
|
|
|
|
|
= $dbh->selectrow_array ($latest_get_sth, undef, $symbol); |
|
606
|
|
|
|
|
|
|
if (defined $last_date && $last_date gt $date) { next; } |
|
607
|
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# "name" from the daily, or retain name from existing latest record. |
|
609
|
|
|
|
|
|
|
$name = $h->{'names'}->{$symbol} // $name; |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# "dividend" from existing latest record retained, but only if same date. |
|
612
|
|
|
|
|
|
|
unless (defined $last_date && $last_date eq $date) { |
|
613
|
|
|
|
|
|
|
undef $dividend; |
|
614
|
|
|
|
|
|
|
} |
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# change by difference from second newest daily, if have one |
|
617
|
|
|
|
|
|
|
my $change = undef; |
|
618
|
|
|
|
|
|
|
if (defined(my $second_close = $data_second{$symbol}->{'close'})) { |
|
619
|
|
|
|
|
|
|
$change = App::Chart::decimal_sub ($newest->{'close'}, $second_close); |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
$timestamp ||= timestamp_now(); |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
my $latest_set_sth = $dbh->prepare_cached |
|
625
|
|
|
|
|
|
|
('INSERT OR REPLACE INTO latest |
|
626
|
|
|
|
|
|
|
(symbol, name, currency, exchange, dividend, |
|
627
|
|
|
|
|
|
|
last_date, open, high, low, last, change, volume, |
|
628
|
|
|
|
|
|
|
source, fetch_timestamp) |
|
629
|
|
|
|
|
|
|
VALUES (?,?,?,?,?, ?,?,?,?,?,?,?, ?,?)'); |
|
630
|
|
|
|
|
|
|
$latest_set_sth->execute |
|
631
|
|
|
|
|
|
|
($symbol, |
|
632
|
|
|
|
|
|
|
$name, |
|
633
|
|
|
|
|
|
|
$h->{'currencies'}->{$symbol}, |
|
634
|
|
|
|
|
|
|
$h->{'exchanges'}->{$symbol}, |
|
635
|
|
|
|
|
|
|
$dividend, |
|
636
|
|
|
|
|
|
|
# |
|
637
|
|
|
|
|
|
|
$newest->{'date'}, |
|
638
|
|
|
|
|
|
|
$newest->{'open'}, |
|
639
|
|
|
|
|
|
|
$newest->{'high'}, |
|
640
|
|
|
|
|
|
|
$newest->{'low'}, |
|
641
|
|
|
|
|
|
|
$newest->{'close'}, |
|
642
|
|
|
|
|
|
|
$change, |
|
643
|
|
|
|
|
|
|
$newest->{'volume'}, |
|
644
|
|
|
|
|
|
|
# |
|
645
|
|
|
|
|
|
|
$h->{'source'}, |
|
646
|
|
|
|
|
|
|
$timestamp); |
|
647
|
|
|
|
|
|
|
$latest_changed{$symbol} = 1; |
|
648
|
|
|
|
|
|
|
} |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
foreach my $dividend (@{$h->{'dividends'}}) { |
|
651
|
|
|
|
|
|
|
my $latest_dividend_sth = $dbh->prepare_cached |
|
652
|
|
|
|
|
|
|
('UPDATE latest SET dividend=? WHERE symbol=? AND last_date=?'); |
|
653
|
|
|
|
|
|
|
my $symbol = $dividend->{'symbol'}; |
|
654
|
|
|
|
|
|
|
if ($latest_dividend_sth->execute ($dividend->{'amount'}, |
|
655
|
|
|
|
|
|
|
$symbol, |
|
656
|
|
|
|
|
|
|
$dividend->{'ex_date'})) { |
|
657
|
|
|
|
|
|
|
$latest_changed{$symbol} = 1; |
|
658
|
|
|
|
|
|
|
} |
|
659
|
|
|
|
|
|
|
} |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
App::Chart::chart_dirbroadcast()->send ('latest-changed', \%latest_changed); |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
require App::Chart::Annotation; |
|
664
|
|
|
|
|
|
|
foreach my $symbol (keys %latest_changed) { |
|
665
|
|
|
|
|
|
|
App::Chart::Annotation::Alert::update_alert ($symbol); |
|
666
|
|
|
|
|
|
|
} |
|
667
|
|
|
|
|
|
|
} |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
sub write_latest_group { |
|
673
|
|
|
|
|
|
|
my ($h) = @_; |
|
674
|
|
|
|
|
|
|
### write_latest_group(): $h |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
crunch_h ($h); |
|
677
|
|
|
|
|
|
|
### crunched: $h |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
my $fetch_timestamp = timestamp_now(); |
|
680
|
|
|
|
|
|
|
my $prefer_decimals = $h->{'prefer_decimals'}; |
|
681
|
|
|
|
|
|
|
my $source = $h->{'source'} |
|
682
|
|
|
|
|
|
|
or croak 'missing "source" for latest records'; |
|
683
|
|
|
|
|
|
|
my %latest; |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
686
|
|
|
|
|
|
|
App::Chart::Database::call_with_transaction |
|
687
|
|
|
|
|
|
|
($dbh, sub { |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached |
|
690
|
|
|
|
|
|
|
('INSERT OR REPLACE INTO latest |
|
691
|
|
|
|
|
|
|
(symbol, name, month, exchange, currency, |
|
692
|
|
|
|
|
|
|
quote_date, quote_time, bid, offer, |
|
693
|
|
|
|
|
|
|
last_date, last_time, open, high, low, last, change, volume, |
|
694
|
|
|
|
|
|
|
note, error, dividend, copyright, source, |
|
695
|
|
|
|
|
|
|
fetch_timestamp, url, etag, last_modified) |
|
696
|
|
|
|
|
|
|
VALUES (?,?,?,?,?, ?,?,?,?, ?,?,?,?,?,?,?,?, ?,?,?,?,?, ?,?,?,?)'); |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
my $resp = $h->{'resp'}; |
|
699
|
|
|
|
|
|
|
my $etag = (defined $resp ? scalar $resp->header('ETag') : undef); |
|
700
|
|
|
|
|
|
|
my $last_modified = (defined $resp ? $resp->last_modified : undef); |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
703
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
704
|
|
|
|
|
|
|
my $this_date = $data->{'date'}; |
|
705
|
|
|
|
|
|
|
if ($latest{$symbol}) { |
|
706
|
|
|
|
|
|
|
my $got_date = $latest{$symbol}->{'date'}; |
|
707
|
|
|
|
|
|
|
if (! defined $got_date || ! defined $this_date) { |
|
708
|
|
|
|
|
|
|
carp "write_latest_group: $source: two records for '$symbol', but no 'date' field"; |
|
709
|
|
|
|
|
|
|
if (DEBUG || 1) { |
|
710
|
|
|
|
|
|
|
require Data::Dumper; |
|
711
|
|
|
|
|
|
|
print Data::Dumper->Dump([$data,$latest{$symbol}], |
|
712
|
|
|
|
|
|
|
['data','latest-so-far']); |
|
713
|
|
|
|
|
|
|
} |
|
714
|
|
|
|
|
|
|
next; |
|
715
|
|
|
|
|
|
|
} |
|
716
|
|
|
|
|
|
|
if ($got_date ge $this_date) { next; } |
|
717
|
|
|
|
|
|
|
} |
|
718
|
|
|
|
|
|
|
$latest{$symbol} = $data; |
|
719
|
|
|
|
|
|
|
} |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
my $error = $h->{'error'}; |
|
722
|
|
|
|
|
|
|
if (! defined $error && defined $resp && ! $resp->is_success) { |
|
723
|
|
|
|
|
|
|
$error = $resp->status_line; |
|
724
|
|
|
|
|
|
|
} |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
foreach my $data (values %latest) { |
|
727
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
my $bid = $data->{'bid'}; |
|
730
|
|
|
|
|
|
|
my $offer = $data->{'offer'}; |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# disallow 0 for prices |
|
733
|
|
|
|
|
|
|
if ($bid && $bid == 0) { $bid = undef; } |
|
734
|
|
|
|
|
|
|
if ($offer && $offer == 0) { $offer = undef; } |
|
735
|
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
my $quote_date = crunch_date ($data->{'quote_date'}); |
|
737
|
|
|
|
|
|
|
my $quote_time = crunch_time ($data->{'quote_time'}); |
|
738
|
|
|
|
|
|
|
if ($quote_time && ! $quote_date) { |
|
739
|
|
|
|
|
|
|
croak "quote_time without quote_date for $symbol"; |
|
740
|
|
|
|
|
|
|
} |
|
741
|
|
|
|
|
|
|
# default quote date/time to now |
|
742
|
|
|
|
|
|
|
if (($bid || $offer) && ! $quote_date) { |
|
743
|
|
|
|
|
|
|
my $symbol_timezone = App::Chart::TZ->for_symbol ($symbol); |
|
744
|
|
|
|
|
|
|
($quote_date, $quote_time) |
|
745
|
|
|
|
|
|
|
= $symbol_timezone->iso_date_time |
|
746
|
|
|
|
|
|
|
(time() - 60 * ($data->{'quote_delay_minutes'} || 0)); |
|
747
|
|
|
|
|
|
|
} |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
my $last_date = crunch_date ($data->{'last_date'} || $data->{'date'}); |
|
750
|
|
|
|
|
|
|
my $last_time = crunch_time ($data->{'last_time'}); |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
my $open = $data->{'open'}; |
|
753
|
|
|
|
|
|
|
my $high = $data->{'high'}; |
|
754
|
|
|
|
|
|
|
my $low = $data->{'low'}; |
|
755
|
|
|
|
|
|
|
my $last = $data->{'last'} || $data->{'close'}; |
|
756
|
|
|
|
|
|
|
my $change = $data->{'change'}; |
|
757
|
|
|
|
|
|
|
my $prev = crunch_price ($data->{'prev'}, $prefer_decimals); |
|
758
|
|
|
|
|
|
|
my $volume = $data->{'volume'}; |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
if (! defined $last) { |
|
761
|
|
|
|
|
|
|
# if there's no last price then try to use the prev |
|
762
|
|
|
|
|
|
|
$open = $high = $low = undef; |
|
763
|
|
|
|
|
|
|
$last = $prev; |
|
764
|
|
|
|
|
|
|
$prev = undef; |
|
765
|
|
|
|
|
|
|
$change = undef; |
|
766
|
|
|
|
|
|
|
$last_date = undef; |
|
767
|
|
|
|
|
|
|
$last_time = undef; |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
} elsif (! defined $change) { |
|
770
|
|
|
|
|
|
|
# if no change given then try to calculate it from last and prev |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
if (! defined $prev) { |
|
773
|
|
|
|
|
|
|
# if no prev then look for one among other $data records, as for |
|
774
|
|
|
|
|
|
|
# when the group is a few consecutive daily data |
|
775
|
|
|
|
|
|
|
my $prev_date; |
|
776
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
777
|
|
|
|
|
|
|
if ($data->{'symbol'} eq $symbol |
|
778
|
|
|
|
|
|
|
&& exists $data->{'date'} |
|
779
|
|
|
|
|
|
|
&& $data->{'date'} lt $last_date |
|
780
|
|
|
|
|
|
|
&& (! $prev_date |
|
781
|
|
|
|
|
|
|
|| $data->{'date'} gt $prev_date)) { |
|
782
|
|
|
|
|
|
|
$prev_date = $data->{'date'}; |
|
783
|
|
|
|
|
|
|
$prev = $data->{'close'}; |
|
784
|
|
|
|
|
|
|
} |
|
785
|
|
|
|
|
|
|
} |
|
786
|
|
|
|
|
|
|
} |
|
787
|
|
|
|
|
|
|
if ($prev) { |
|
788
|
|
|
|
|
|
|
$change = App::Chart::decimal_sub ($last, $prev); |
|
789
|
|
|
|
|
|
|
} |
|
790
|
|
|
|
|
|
|
} |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
$sth->execute ($symbol, |
|
793
|
|
|
|
|
|
|
$h->{'names'}->{$symbol}, |
|
794
|
|
|
|
|
|
|
$data->{'month'}, |
|
795
|
|
|
|
|
|
|
$h->{'exchanges'}->{$symbol}, |
|
796
|
|
|
|
|
|
|
$h->{'currencies'}->{$symbol}, |
|
797
|
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
$quote_date, $quote_time, |
|
799
|
|
|
|
|
|
|
$bid, $offer, |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
$last_date, $last_time, |
|
802
|
|
|
|
|
|
|
$open, $high, $low, $last, $change, $volume, |
|
803
|
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
$data->{'note'}, |
|
805
|
|
|
|
|
|
|
$data->{'error'} || $error, |
|
806
|
|
|
|
|
|
|
$data->{'dividend'}, |
|
807
|
|
|
|
|
|
|
$h->{'copyright'}, |
|
808
|
|
|
|
|
|
|
$source, |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
$fetch_timestamp, |
|
811
|
|
|
|
|
|
|
$h->{'url'}, |
|
812
|
|
|
|
|
|
|
$etag, |
|
813
|
|
|
|
|
|
|
$last_modified); |
|
814
|
|
|
|
|
|
|
$sth->finish; |
|
815
|
|
|
|
|
|
|
} |
|
816
|
|
|
|
|
|
|
}); |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
App::Chart::chart_dirbroadcast()->send ('latest-changed', \%latest); |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
require App::Chart::Annotation; |
|
821
|
|
|
|
|
|
|
foreach my $symbol (keys %latest) { |
|
822
|
|
|
|
|
|
|
App::Chart::Annotation::Alert::update_alert ($symbol); |
|
823
|
|
|
|
|
|
|
} |
|
824
|
|
|
|
|
|
|
} |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
sub iso_to_MMM_YY { |
|
827
|
|
|
|
|
|
|
my ($iso) = @_; |
|
828
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::iso_to_ymd ($iso); |
|
829
|
|
|
|
|
|
|
return sprintf ("%.3s %02d", |
|
830
|
|
|
|
|
|
|
uc(Date::Calc::Month_to_Text ($month)), |
|
831
|
|
|
|
|
|
|
$year % 100); |
|
832
|
|
|
|
|
|
|
} |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
my $iso_date_re = qr/^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$/; |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
my %date_format_to_func |
|
839
|
|
|
|
|
|
|
= ('ymd' => \&App::Chart::Download::Decode_Date_YMD_to_iso, |
|
840
|
|
|
|
|
|
|
'dmy' => \&App::Chart::Download::Decode_Date_EU_to_iso, |
|
841
|
|
|
|
|
|
|
'mdy' => \&App::Chart::Download::Decode_Date_US_to_iso); |
|
842
|
|
|
|
|
|
|
sub noop { |
|
843
|
|
|
|
|
|
|
return $_[0]; |
|
844
|
|
|
|
|
|
|
} |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
my %date_format_to_month_func |
|
847
|
|
|
|
|
|
|
= ('ymd' => \&crunch_month_ymd); |
|
848
|
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub crunch_month_ymd { |
|
850
|
|
|
|
|
|
|
my ($str) = @_; |
|
851
|
|
|
|
|
|
|
my ($year, $month, $day) = Date::Calc::Decode_Date_EU ($str); |
|
852
|
|
|
|
|
|
|
if (! defined $year) { |
|
853
|
|
|
|
|
|
|
croak "unrecognised month string: $str"; |
|
854
|
|
|
|
|
|
|
} |
|
855
|
|
|
|
|
|
|
if (defined $day) { |
|
856
|
|
|
|
|
|
|
if ($day != 1) { croak "month with day!=1: '$str' got $day"; } |
|
857
|
|
|
|
|
|
|
} else { |
|
858
|
|
|
|
|
|
|
$day = 1; |
|
859
|
|
|
|
|
|
|
} |
|
860
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso ($year, $month, $day); |
|
861
|
|
|
|
|
|
|
} |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
sub crunch_h { |
|
864
|
|
|
|
|
|
|
my ($h) = @_; |
|
865
|
|
|
|
|
|
|
my $database_symbols_hash = App::Chart::Database::database_symbols_hash(); |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# ignore undef where expecting hashrefs in 'data' and 'dividends' arefs |
|
868
|
|
|
|
|
|
|
foreach my $elem ('data', |
|
869
|
|
|
|
|
|
|
'dividends') { |
|
870
|
|
|
|
|
|
|
my $aref = $h->{$elem} // next; |
|
871
|
|
|
|
|
|
|
@$aref = grep { |
|
872
|
|
|
|
|
|
|
defined $_ |
|
873
|
|
|
|
|
|
|
# && App::Chart::Database->symbol_exists($_->{'symbol'}) |
|
874
|
|
|
|
|
|
|
} @$aref; |
|
875
|
|
|
|
|
|
|
} |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
my $suffix = $h->{'suffix'}; |
|
878
|
|
|
|
|
|
|
my $month_format = $h->{'month_format'}; |
|
879
|
|
|
|
|
|
|
my $prefer_decimals = $h->{'prefer_decimals'}; |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
my $date_format = delete $h->{'date_format'}; |
|
882
|
|
|
|
|
|
|
my $date_func = ($date_format ? $date_format_to_func{$date_format} : \&noop) |
|
883
|
|
|
|
|
|
|
|| croak "Unrecognised date_format '$date_format'"; |
|
884
|
|
|
|
|
|
|
# my $month_func = $date_format ? $date_format_to_month_func{$date_format} : \&noop; |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
my %currencies; $h->{'currencies'} = \%currencies; |
|
887
|
|
|
|
|
|
|
my %isins; $h->{'isins'} = \%isins; |
|
888
|
|
|
|
|
|
|
my %names; $h->{'names'} = \%names; |
|
889
|
|
|
|
|
|
|
my %exchanges; $h->{'exchanges'} = \%exchanges; |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
foreach my $info (@{$h->{'info'}}) { |
|
892
|
|
|
|
|
|
|
my $symbol = $info->{'symbol'} |
|
893
|
|
|
|
|
|
|
or croak "write_daily_group: missing symbol in info record"; |
|
894
|
|
|
|
|
|
|
if (! exists $database_symbols_hash->{$symbol}) { next; } |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
$names{$symbol} ||= delete $info->{'name'}; |
|
897
|
|
|
|
|
|
|
$currencies{$symbol} ||= delete $info->{'currency'}; |
|
898
|
|
|
|
|
|
|
$exchanges{$symbol} ||= delete $info->{'exchange'}; |
|
899
|
|
|
|
|
|
|
$isins{$symbol} ||= delete $info->{'isin'}; |
|
900
|
|
|
|
|
|
|
} |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
903
|
|
|
|
|
|
|
my $month = $data->{'month'}; |
|
904
|
|
|
|
|
|
|
if (defined $month) { |
|
905
|
|
|
|
|
|
|
# $month = $data->{'month'} = $month_func->($month); |
|
906
|
|
|
|
|
|
|
$month =~ $iso_date_re or croak "Bad month value '$month'"; |
|
907
|
|
|
|
|
|
|
} |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
910
|
|
|
|
|
|
|
if (! defined $symbol) { |
|
911
|
|
|
|
|
|
|
# symbols built from commodity + month |
|
912
|
|
|
|
|
|
|
my $commodity = $data->{'commodity'} |
|
913
|
|
|
|
|
|
|
// croak "neither symbol nor commodity in 'data' element"; |
|
914
|
|
|
|
|
|
|
$month // croak "Group data: no 'month' to go with 'commodity' in data element"; |
|
915
|
|
|
|
|
|
|
$symbol = $data->{'symbol'} |
|
916
|
|
|
|
|
|
|
= $commodity . ' ' . iso_to_MMM_YY($month) . $suffix; |
|
917
|
|
|
|
|
|
|
} |
|
918
|
|
|
|
|
|
|
# if ($month_format eq 'MMM_YY') { |
|
919
|
|
|
|
|
|
|
# $month = iso_to_MMM_YY ($month); |
|
920
|
|
|
|
|
|
|
# } else { |
|
921
|
|
|
|
|
|
|
# croak "unrecognised month format: $month_format"; |
|
922
|
|
|
|
|
|
|
# } |
|
923
|
|
|
|
|
|
|
} |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
if ($h->{'front_month'}) { |
|
926
|
|
|
|
|
|
|
my %front; |
|
927
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
928
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
929
|
|
|
|
|
|
|
my $front_symbol |
|
930
|
|
|
|
|
|
|
= App::Chart::symbol_commodity($symbol) |
|
931
|
|
|
|
|
|
|
. App::Chart::symbol_suffix($symbol); |
|
932
|
|
|
|
|
|
|
if (! $front{$front_symbol} |
|
933
|
|
|
|
|
|
|
|| $data->{'month'} gt $front{$front_symbol}->{'month'}) { |
|
934
|
|
|
|
|
|
|
$front{$front_symbol} = $data; |
|
935
|
|
|
|
|
|
|
} |
|
936
|
|
|
|
|
|
|
} |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
while (my ($symbol, $data) = each %front) { |
|
939
|
|
|
|
|
|
|
$data = { %$data }; |
|
940
|
|
|
|
|
|
|
$data->{'symbol'} = $symbol; |
|
941
|
|
|
|
|
|
|
push @{$h->{'data'}}, $data; |
|
942
|
|
|
|
|
|
|
} |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
foreach my $data (@{$h->{'data'}}) { |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
foreach my $field ('date', 'quote_date', 'last_date') { |
|
948
|
|
|
|
|
|
|
if (defined $data->{$field}) { |
|
949
|
|
|
|
|
|
|
$data->{$field} = crunch_date ($data->{$field}, $date_format); |
|
950
|
|
|
|
|
|
|
} |
|
951
|
|
|
|
|
|
|
} |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
# empty volume or openint taken to be no data (as opposed to '0' for |
|
954
|
|
|
|
|
|
|
# zero volume or int) |
|
955
|
|
|
|
|
|
|
foreach my $field ('volume', 'openint') { |
|
956
|
|
|
|
|
|
|
if (defined $data->{$field} && $data->{$field} eq '') { |
|
957
|
|
|
|
|
|
|
$data->{$field} = undef; |
|
958
|
|
|
|
|
|
|
} |
|
959
|
|
|
|
|
|
|
} |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
if (my $sessions = delete $data->{'sessions'}) { |
|
962
|
|
|
|
|
|
|
my @sessions = grep {defined} map {crunch_price($_)} @$sessions; |
|
963
|
|
|
|
|
|
|
$data->{'open'} = $sessions[0]; |
|
964
|
|
|
|
|
|
|
($data->{'low'}, $data->{'high'}) = List::MoreUtils::minmax (@sessions); |
|
965
|
|
|
|
|
|
|
$data->{'close'} = $sessions[-1]; |
|
966
|
|
|
|
|
|
|
} |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
if (exists $data->{'change'}) { |
|
969
|
|
|
|
|
|
|
$data->{'change'} = crunch_change ($data->{'change'}, $prefer_decimals); |
|
970
|
|
|
|
|
|
|
} |
|
971
|
|
|
|
|
|
|
foreach my $field (qw(bid offer open high low close last)) { |
|
972
|
|
|
|
|
|
|
if (exists $data->{$field}) { |
|
973
|
|
|
|
|
|
|
$data->{$field} = crunch_price ($data->{$field}, $prefer_decimals); |
|
974
|
|
|
|
|
|
|
} |
|
975
|
|
|
|
|
|
|
} |
|
976
|
|
|
|
|
|
|
foreach my $field (qw(volume openint)) { |
|
977
|
|
|
|
|
|
|
if (exists $data->{$field}) { |
|
978
|
|
|
|
|
|
|
$data->{$field} = crunch_number ($data->{$field}); |
|
979
|
|
|
|
|
|
|
} |
|
980
|
|
|
|
|
|
|
} |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
my $symbol = $data->{'symbol'}; |
|
983
|
|
|
|
|
|
|
$currencies{$symbol} ||= delete $data->{'currency'} || $h->{'currency'}; |
|
984
|
|
|
|
|
|
|
$names{$symbol} ||= delete $data->{'name'} || $h->{'name'}; |
|
985
|
|
|
|
|
|
|
$exchanges{$symbol} ||= delete $data->{'exchange'}; |
|
986
|
|
|
|
|
|
|
$isins{$symbol} ||= delete $data->{'isin'}; |
|
987
|
|
|
|
|
|
|
} |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
foreach my $dividend (@{$h->{'dividends'}}) { |
|
990
|
|
|
|
|
|
|
foreach my $field ('ex_date', 'record_date', 'pay_date') { |
|
991
|
|
|
|
|
|
|
if (defined $dividend->{$field}) { |
|
992
|
|
|
|
|
|
|
$dividend->{$field} = crunch_date ($dividend->{$field}, $date_format); |
|
993
|
|
|
|
|
|
|
} |
|
994
|
|
|
|
|
|
|
} |
|
995
|
|
|
|
|
|
|
$dividend->{'ex_date'} |
|
996
|
|
|
|
|
|
|
or croak 'Group data: missing ex_date in dividend record'; |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
foreach my $field (qw(amount imputation)) { |
|
999
|
|
|
|
|
|
|
if (exists $dividend->{$field}) { |
|
1000
|
|
|
|
|
|
|
$dividend->{$field} = crunch_price ($dividend->{$field}, $prefer_decimals); |
|
1001
|
|
|
|
|
|
|
} |
|
1002
|
|
|
|
|
|
|
} |
|
1003
|
|
|
|
|
|
|
} |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
foreach my $split (@{$h->{'splits'}}) { |
|
1006
|
|
|
|
|
|
|
if (defined $split->{'date'}) { |
|
1007
|
|
|
|
|
|
|
$split->{'date'} = crunch_date ($split->{'date'}, $date_format); |
|
1008
|
|
|
|
|
|
|
} |
|
1009
|
|
|
|
|
|
|
$split->{'date'} |
|
1010
|
|
|
|
|
|
|
or croak "Group data: missing 'date' in split record"; |
|
1011
|
|
|
|
|
|
|
} |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
# whitespace in names, and possible leading/trailing in isins |
|
1014
|
|
|
|
|
|
|
foreach my $href (\%names, \%currencies, \%exchanges, \%isins) { |
|
1015
|
|
|
|
|
|
|
hash_delete_undefs ($href); |
|
1016
|
|
|
|
|
|
|
} |
|
1017
|
|
|
|
|
|
|
foreach (values %names, values %isins) { |
|
1018
|
|
|
|
|
|
|
$_ = App::Chart::collapse_whitespace ($_); |
|
1019
|
|
|
|
|
|
|
} |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
if (eval { require Business::ISIN; 1 }) { |
|
1022
|
|
|
|
|
|
|
my $bi = Business::ISIN->new; |
|
1023
|
|
|
|
|
|
|
while (my ($symbol, $isin) = each %isins) { |
|
1024
|
|
|
|
|
|
|
$bi->set ($isin); |
|
1025
|
|
|
|
|
|
|
if ($bi->is_valid) { next; } |
|
1026
|
|
|
|
|
|
|
warn "$symbol ISIN '$isin' is invalid, ignoring: ", $bi->error; |
|
1027
|
|
|
|
|
|
|
delete $isins{$symbol}; |
|
1028
|
|
|
|
|
|
|
} |
|
1029
|
|
|
|
|
|
|
} |
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
sub hash_delete_undefs { |
|
1033
|
|
|
|
|
|
|
my ($href) = @_; |
|
1034
|
|
|
|
|
|
|
while (my ($key, $value) = each %$href) { |
|
1035
|
|
|
|
|
|
|
if (! defined $value) { |
|
1036
|
|
|
|
|
|
|
delete $href->{$key}; |
|
1037
|
|
|
|
|
|
|
} |
|
1038
|
|
|
|
|
|
|
} |
|
1039
|
|
|
|
|
|
|
} |
|
1040
|
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
sub crunch_date { |
|
1042
|
|
|
|
|
|
|
my ($str, $format) = @_; |
|
1043
|
|
|
|
|
|
|
$str = crunch_empty_undef ($str); |
|
1044
|
|
|
|
|
|
|
if (! defined $str) { return $str; } |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
if (defined $format) { |
|
1047
|
|
|
|
|
|
|
my $func = $date_format_to_func{$format}; |
|
1048
|
|
|
|
|
|
|
defined $func or croak "Unrecognised date_format spec: $format"; |
|
1049
|
|
|
|
|
|
|
$str = &$func ($str); |
|
1050
|
|
|
|
|
|
|
} |
|
1051
|
|
|
|
|
|
|
$str =~ $iso_date_re or croak "Bad date '$str'"; |
|
1052
|
|
|
|
|
|
|
return $str; |
|
1053
|
|
|
|
|
|
|
} |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
sub crunch_price { |
|
1056
|
|
|
|
|
|
|
my ($str, $prefer_decimals) = @_; |
|
1057
|
|
|
|
|
|
|
$str = crunch_change ($str, $prefer_decimals) // return undef; |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
if (str_is_zero ($str)) { return undef; } |
|
1060
|
|
|
|
|
|
|
return $str; |
|
1061
|
|
|
|
|
|
|
} |
|
1062
|
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
sub crunch_change { |
|
1064
|
|
|
|
|
|
|
my ($str, $prefer_decimals) = @_; |
|
1065
|
|
|
|
|
|
|
$str = crunch_number ($str) // return undef; |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
if ($str eq '') { return undef; } # empty |
|
1068
|
|
|
|
|
|
|
if (uc($str) eq 'CLOSED') { return undef; } # RBA 2003-2006.xls |
|
1069
|
|
|
|
|
|
|
if ($str eq 'unch') { return '0'; } # unchanged |
|
1070
|
|
|
|
|
|
|
if (defined $prefer_decimals) { |
|
1071
|
|
|
|
|
|
|
return App::Chart::Download::trim_decimals ($str, $prefer_decimals); |
|
1072
|
|
|
|
|
|
|
} else { |
|
1073
|
|
|
|
|
|
|
return $str; |
|
1074
|
|
|
|
|
|
|
} |
|
1075
|
|
|
|
|
|
|
} |
|
1076
|
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
sub crunch_number { |
|
1078
|
|
|
|
|
|
|
my ($str) = @_; |
|
1079
|
|
|
|
|
|
|
if (! defined $str) { return undef; } |
|
1080
|
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
$str =~ s/$RE{ws}{crop}//go; # leading and trailing whitespace |
|
1082
|
|
|
|
|
|
|
$str =~ s/^\+//; # leading + sign |
|
1083
|
|
|
|
|
|
|
$str =~ s/^0+([1-9]|0\.|0$)/$1/; # leading extra zeros |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
if ($str eq '' |
|
1086
|
|
|
|
|
|
|
|| $str eq '-' |
|
1087
|
|
|
|
|
|
|
|| $str eq 'N/A' |
|
1088
|
|
|
|
|
|
|
|| $str eq 'n/a') { |
|
1089
|
|
|
|
|
|
|
return undef; |
|
1090
|
|
|
|
|
|
|
} |
|
1091
|
|
|
|
|
|
|
$str =~ s/,//g; # commas for thousands |
|
1092
|
|
|
|
|
|
|
return $str; |
|
1093
|
|
|
|
|
|
|
} |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
sub crunch_time { |
|
1096
|
|
|
|
|
|
|
my ($str) = @_; |
|
1097
|
|
|
|
|
|
|
$str = crunch_empty_undef ($str); |
|
1098
|
|
|
|
|
|
|
if (! defined $str) { return undef; } |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
$str =~ /^([0-9]?[0-9])(:[0-9][0-9])(:[0-9][0-9])?([ap]m)?$/i |
|
1101
|
|
|
|
|
|
|
or croak "bad time '$str'"; |
|
1102
|
|
|
|
|
|
|
my $hour = $1; |
|
1103
|
|
|
|
|
|
|
my $minute = $2; |
|
1104
|
|
|
|
|
|
|
my $second = $3; |
|
1105
|
|
|
|
|
|
|
my $am_pm = $4; |
|
1106
|
|
|
|
|
|
|
$second //= ':00'; |
|
1107
|
|
|
|
|
|
|
if (defined $am_pm && lc $am_pm eq 'pm') { $hour += 12; } |
|
1108
|
|
|
|
|
|
|
$hour = sprintf '%02d', $hour; |
|
1109
|
|
|
|
|
|
|
return "$hour$minute$second"; |
|
1110
|
|
|
|
|
|
|
} |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
sub crunch_empty_undef { |
|
1113
|
|
|
|
|
|
|
my ($str) = @_; |
|
1114
|
|
|
|
|
|
|
if (! defined $str) { return $str; } |
|
1115
|
|
|
|
|
|
|
$str =~ s/$RE{ws}{crop}//go; # leading and trailing whitespace |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
# eg. string "N/A" in dates and times from Yahoo |
|
1118
|
|
|
|
|
|
|
if ($str eq '' || $str eq 'N/A') { return undef; } |
|
1119
|
|
|
|
|
|
|
return $str; |
|
1120
|
|
|
|
|
|
|
} |
|
1121
|
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
sub set_symbol_name { |
|
1126
|
|
|
|
|
|
|
my ($symbol, $name) = @_; |
|
1127
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
1128
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('UPDATE info SET name=? WHERE symbol=?'); |
|
1129
|
|
|
|
|
|
|
my $changed = $sth->execute($name, $symbol); |
|
1130
|
|
|
|
|
|
|
$sth->finish(); |
|
1131
|
|
|
|
|
|
|
return $changed; |
|
1132
|
|
|
|
|
|
|
} |
|
1133
|
|
|
|
|
|
|
sub set_currency { |
|
1134
|
|
|
|
|
|
|
my ($symbol, $currency) = @_; |
|
1135
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
1136
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('UPDATE info SET currency=? WHERE symbol=?'); |
|
1137
|
|
|
|
|
|
|
my $changed = $sth->execute($currency, $symbol); |
|
1138
|
|
|
|
|
|
|
$sth->finish(); |
|
1139
|
|
|
|
|
|
|
return $changed; |
|
1140
|
|
|
|
|
|
|
} |
|
1141
|
|
|
|
|
|
|
sub set_exchange { |
|
1142
|
|
|
|
|
|
|
my ($symbol, $exchange) = @_; |
|
1143
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
1144
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('UPDATE info SET exchange=? WHERE symbol=?'); |
|
1145
|
|
|
|
|
|
|
my $changed = $sth->execute($exchange, $symbol); |
|
1146
|
|
|
|
|
|
|
$sth->finish(); |
|
1147
|
|
|
|
|
|
|
return $changed; |
|
1148
|
|
|
|
|
|
|
} |
|
1149
|
|
|
|
|
|
|
sub set_decimals { |
|
1150
|
|
|
|
|
|
|
my ($symbol, $decimals) = @_; |
|
1151
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
1152
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('UPDATE info SET decimals=? WHERE symbol=?'); |
|
1153
|
|
|
|
|
|
|
my $changed = $sth->execute($decimals, $symbol); |
|
1154
|
|
|
|
|
|
|
$sth->finish(); |
|
1155
|
|
|
|
|
|
|
return $changed; |
|
1156
|
|
|
|
|
|
|
} |
|
1157
|
|
|
|
|
|
|
sub set_isin { |
|
1158
|
|
|
|
|
|
|
my ($symbol, $isin) = @_; |
|
1159
|
|
|
|
|
|
|
my $dbh = App::Chart::DBI->instance; |
|
1160
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('UPDATE info SET isin=? WHERE symbol=?'); |
|
1161
|
|
|
|
|
|
|
my $changed = $sth->execute($isin, $symbol); |
|
1162
|
|
|
|
|
|
|
$sth->finish(); |
|
1163
|
|
|
|
|
|
|
return $changed; |
|
1164
|
|
|
|
|
|
|
} |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1168
|
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
# return true if $timestamp string is within the past $seconds from now |
|
1170
|
|
|
|
|
|
|
# also return true if $timestamp is some strange future value |
|
1171
|
|
|
|
|
|
|
sub timestamp_within { |
|
1172
|
|
|
|
|
|
|
my ($timestamp, $seconds) = @_; |
|
1173
|
|
|
|
|
|
|
if (! defined $timestamp) { return 0; } # undef stamp always out of range |
|
1174
|
|
|
|
|
|
|
my ($lo, $hi) = timestamp_range ($seconds); |
|
1175
|
|
|
|
|
|
|
return (($timestamp ge $lo) && ($timestamp le $hi)); |
|
1176
|
|
|
|
|
|
|
} |
|
1177
|
|
|
|
|
|
|
sub timestamp_range { |
|
1178
|
|
|
|
|
|
|
my ($seconds) = @_; |
|
1179
|
|
|
|
|
|
|
my $t = time(); |
|
1180
|
|
|
|
|
|
|
my $lo = $t - $seconds; |
|
1181
|
|
|
|
|
|
|
my $hi = $t + 6*3600; # 2 hours future |
|
1182
|
|
|
|
|
|
|
return (timet_to_timestamp($lo), |
|
1183
|
|
|
|
|
|
|
timet_to_timestamp($hi)); |
|
1184
|
|
|
|
|
|
|
} |
|
1185
|
|
|
|
|
|
|
sub timestamp_now { |
|
1186
|
|
|
|
|
|
|
return timet_to_timestamp(time()); |
|
1187
|
|
|
|
|
|
|
} |
|
1188
|
|
|
|
|
|
|
sub timet_to_timestamp { |
|
1189
|
|
|
|
|
|
|
my ($t) = @_; |
|
1190
|
|
|
|
|
|
|
return POSIX::strftime ('%Y-%m-%d %H:%M:%S+00:00', gmtime($t)); |
|
1191
|
|
|
|
|
|
|
} |
|
1192
|
|
|
|
|
|
|
sub timestamp_to_ymdhms { |
|
1193
|
|
|
|
|
|
|
my ($timestamp) = @_; |
|
1194
|
|
|
|
|
|
|
return split /[- :+]/, $timestamp; |
|
1195
|
|
|
|
|
|
|
} |
|
1196
|
|
|
|
|
|
|
sub timestamp_to_timet { |
|
1197
|
|
|
|
|
|
|
my ($timestamp) = @_; |
|
1198
|
|
|
|
|
|
|
my ($year, $month, $day, $hour, $minute, $second) |
|
1199
|
|
|
|
|
|
|
= timestamp_to_ymdhms($timestamp); |
|
1200
|
|
|
|
|
|
|
require Time::Local; |
|
1201
|
|
|
|
|
|
|
return Time::Local::timegm |
|
1202
|
|
|
|
|
|
|
($second, $minute, $hour, $day, $month-1, $year-1900); |
|
1203
|
|
|
|
|
|
|
} |
|
1204
|
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1207
|
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
sub tdate_strftime { |
|
1209
|
|
|
|
|
|
|
my ($format, $tdate) = @_; |
|
1210
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::tdate_to_ymd ($tdate); |
|
1211
|
|
|
|
|
|
|
require App::Chart::Timebase; |
|
1212
|
|
|
|
|
|
|
return App::Chart::Timebase::strftime_ymd ($format, $year, $month, $day); |
|
1213
|
|
|
|
|
|
|
} |
|
1214
|
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
sub tdate_range_string { |
|
1216
|
|
|
|
|
|
|
my ($lo, $hi) = @_; |
|
1217
|
|
|
|
|
|
|
if (@_ < 2) { $hi = $lo; } |
|
1218
|
|
|
|
|
|
|
my $d_fmt = $App::Chart::option{'d_fmt'}; |
|
1219
|
|
|
|
|
|
|
if ($lo == $hi) { |
|
1220
|
|
|
|
|
|
|
return tdate_strftime ($d_fmt, $lo); |
|
1221
|
|
|
|
|
|
|
} else { |
|
1222
|
|
|
|
|
|
|
return __x('{lodate} to {hidate}', |
|
1223
|
|
|
|
|
|
|
lodate => tdate_strftime ($d_fmt, $lo), |
|
1224
|
|
|
|
|
|
|
hidate => tdate_strftime ($d_fmt, $hi)); |
|
1225
|
|
|
|
|
|
|
} |
|
1226
|
|
|
|
|
|
|
} |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
sub symbol_range_string { |
|
1229
|
|
|
|
|
|
|
my ($symbol_list) = @_; |
|
1230
|
|
|
|
|
|
|
if (@$symbol_list == 0) { |
|
1231
|
|
|
|
|
|
|
return ''; |
|
1232
|
|
|
|
|
|
|
} elsif (@$symbol_list == 1) { |
|
1233
|
|
|
|
|
|
|
return $symbol_list->[0]; |
|
1234
|
|
|
|
|
|
|
} else { |
|
1235
|
|
|
|
|
|
|
return __x('{start_symbol} to {end_symbol}', |
|
1236
|
|
|
|
|
|
|
start_symbol => $symbol_list->[0], |
|
1237
|
|
|
|
|
|
|
end_symbol => $symbol_list->[-1]); |
|
1238
|
|
|
|
|
|
|
} |
|
1239
|
|
|
|
|
|
|
} |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1242
|
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
sub weekday_date_after_time { |
|
1244
|
|
|
|
|
|
|
return App::Chart::tdate_to_iso (weekday_tdate_after_time (@_)); |
|
1245
|
|
|
|
|
|
|
} |
|
1246
|
|
|
|
|
|
|
sub weekday_tdate_after_time { |
|
1247
|
|
|
|
|
|
|
my ($after_hour,$after_min, $timezone, $offset) = @_; |
|
1248
|
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
local $Tie::TZ::TZ = $timezone->tz; |
|
1250
|
|
|
|
|
|
|
my ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) |
|
1251
|
|
|
|
|
|
|
= Date::Calc::Localtime(); |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
my $tdate = App::Chart::ymd_to_tdate_floor ($year,$month,$day) |
|
1254
|
|
|
|
|
|
|
+ ($offset // 0); |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
if ($dow >= 6 # Saturday or Sunday |
|
1257
|
|
|
|
|
|
|
|| ($hour*60+$min < $after_hour*60+$after_min)) { |
|
1258
|
|
|
|
|
|
|
$tdate--; |
|
1259
|
|
|
|
|
|
|
} |
|
1260
|
|
|
|
|
|
|
return $tdate; |
|
1261
|
|
|
|
|
|
|
} |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
sub download { |
|
1266
|
|
|
|
|
|
|
my (%options) = @_; |
|
1267
|
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
my @symbol_list = (); |
|
1269
|
|
|
|
|
|
|
{ |
|
1270
|
|
|
|
|
|
|
my $symbol_list = $options{'symbol_list'} |
|
1271
|
|
|
|
|
|
|
|| croak "download() missing symbol_list\n"; |
|
1272
|
|
|
|
|
|
|
@symbol_list = @$symbol_list; |
|
1273
|
|
|
|
|
|
|
} |
|
1274
|
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
@symbol_list = List::MoreUtils::uniq (@symbol_list); |
|
1276
|
|
|
|
|
|
|
verbose_message (__('Download:'), @symbol_list); |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
foreach my $symbol (@symbol_list) { |
|
1279
|
|
|
|
|
|
|
App::Chart::symbol_setups ($symbol); |
|
1280
|
|
|
|
|
|
|
} |
|
1281
|
|
|
|
|
|
|
App::Chart::Database->add_symbol (@symbol_list); |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
require App::Chart::DownloadHandler; |
|
1284
|
|
|
|
|
|
|
my $all_ok = 1; |
|
1285
|
|
|
|
|
|
|
foreach my $handler (@App::Chart::DownloadHandler::handler_list) { |
|
1286
|
|
|
|
|
|
|
my @this_list = grep {$handler->match($_)} @symbol_list; |
|
1287
|
|
|
|
|
|
|
my $ok = $handler->download (\@this_list); |
|
1288
|
|
|
|
|
|
|
if (! $ok) { $all_ok = 0; } |
|
1289
|
|
|
|
|
|
|
} |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
# my %handler_result = (); |
|
1292
|
|
|
|
|
|
|
# foreach my $symbol (@symbol_list) { |
|
1293
|
|
|
|
|
|
|
# |
|
1294
|
|
|
|
|
|
|
# my @handlers = App::Chart::DownloadHandler->handlers_for_symbol ($symbol); |
|
1295
|
|
|
|
|
|
|
# foreach my $handler (@handlers) { |
|
1296
|
|
|
|
|
|
|
# if (exists $handler_result{$handler}) { |
|
1297
|
|
|
|
|
|
|
# if (! $handler_result{$handler}) { $all_ok = 0; } |
|
1298
|
|
|
|
|
|
|
# next; |
|
1299
|
|
|
|
|
|
|
# } |
|
1300
|
|
|
|
|
|
|
# |
|
1301
|
|
|
|
|
|
|
# my @this_list = grep { my $symbol = $_; |
|
1302
|
|
|
|
|
|
|
# List::MoreUtils::all |
|
1303
|
|
|
|
|
|
|
# {$_->match($symbol)} @handlers |
|
1304
|
|
|
|
|
|
|
# } @symbol_list; |
|
1305
|
|
|
|
|
|
|
# my $ok = $handler->download (\@this_list); |
|
1306
|
|
|
|
|
|
|
# $handler_result{$handler} = $ok; |
|
1307
|
|
|
|
|
|
|
# } |
|
1308
|
|
|
|
|
|
|
# |
|
1309
|
|
|
|
|
|
|
# } |
|
1310
|
|
|
|
|
|
|
status (__('Checking historical')); |
|
1311
|
|
|
|
|
|
|
if ($all_ok) { |
|
1312
|
|
|
|
|
|
|
consider_historical (\@symbol_list); |
|
1313
|
|
|
|
|
|
|
} |
|
1314
|
|
|
|
|
|
|
} |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
# return a list of symbols, either just ($symbol), or if $symbol has |
|
1317
|
|
|
|
|
|
|
# wildcards then the result of matching that in the "all" list |
|
1318
|
|
|
|
|
|
|
sub symbol_glob { |
|
1319
|
|
|
|
|
|
|
my ($symbol) = @_; |
|
1320
|
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
if ($symbol =~ /[*?]/) { |
|
1322
|
|
|
|
|
|
|
require Text::Glob; |
|
1323
|
|
|
|
|
|
|
require App::Chart::Gtk2::Symlist::All; |
|
1324
|
|
|
|
|
|
|
my $symlist = App::Chart::Gtk2::Symlist::All->instance; |
|
1325
|
|
|
|
|
|
|
my $regexp = Text::Glob::glob_to_regex ($symbol); |
|
1326
|
|
|
|
|
|
|
my @list = grep {$_ =~ $regexp} $symlist->symbols; |
|
1327
|
|
|
|
|
|
|
if (! @list) { |
|
1328
|
|
|
|
|
|
|
print __x("Warning, pattern \"{pattern}\" doesn't match anything in the database, ignoring\n", |
|
1329
|
|
|
|
|
|
|
pattern => $symbol); |
|
1330
|
|
|
|
|
|
|
} |
|
1331
|
|
|
|
|
|
|
return @list; |
|
1332
|
|
|
|
|
|
|
} else { |
|
1333
|
|
|
|
|
|
|
return ($symbol); |
|
1334
|
|
|
|
|
|
|
} |
|
1335
|
|
|
|
|
|
|
} |
|
1336
|
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
sub command_line_download { |
|
1338
|
|
|
|
|
|
|
my ($class, $output, $args) = @_; |
|
1339
|
|
|
|
|
|
|
my $hash; |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
if ($output eq 'tty') { |
|
1342
|
|
|
|
|
|
|
if (-t STDOUT) { |
|
1343
|
|
|
|
|
|
|
binmode (STDOUT, ':via(EscStatus)') |
|
1344
|
|
|
|
|
|
|
or die 'Cannot push EscStatus'; |
|
1345
|
|
|
|
|
|
|
} else { |
|
1346
|
|
|
|
|
|
|
require PerlIO::via::EscStatus::ShowNone; |
|
1347
|
|
|
|
|
|
|
binmode (STDOUT, ':via(EscStatus::ShowNone)') |
|
1348
|
|
|
|
|
|
|
or die 'Cannot push EscStatus::ShowNone'; |
|
1349
|
|
|
|
|
|
|
} |
|
1350
|
|
|
|
|
|
|
} elsif ($output eq 'all-status') { |
|
1351
|
|
|
|
|
|
|
require PerlIO::via::EscStatus::ShowAll; |
|
1352
|
|
|
|
|
|
|
binmode (STDOUT, ':via(EscStatus::ShowAll)') |
|
1353
|
|
|
|
|
|
|
or die 'Cannot push EscStatus::ShowAll'; |
|
1354
|
|
|
|
|
|
|
} |
|
1355
|
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
if (! @$args) { |
|
1357
|
|
|
|
|
|
|
print __"No symbols specified to download\n"; |
|
1358
|
|
|
|
|
|
|
return; |
|
1359
|
|
|
|
|
|
|
} |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
my @symbol_list = (); |
|
1362
|
|
|
|
|
|
|
foreach my $arg (@$args) { |
|
1363
|
|
|
|
|
|
|
if (ref $arg) { |
|
1364
|
|
|
|
|
|
|
# only what's already in the database |
|
1365
|
|
|
|
|
|
|
$hash ||= App::Chart::Database::database_symbols_hash(); |
|
1366
|
|
|
|
|
|
|
my @list = grep {exists $hash->{$_}} $arg->symbols; |
|
1367
|
|
|
|
|
|
|
push @symbol_list, @list; |
|
1368
|
|
|
|
|
|
|
if (! @list) { |
|
1369
|
|
|
|
|
|
|
print __x("Warning, no symbols in \"{symlist}\" are currently in the database\n(only symbols already in the database are downloaded from lists)\n", |
|
1370
|
|
|
|
|
|
|
symlist => $arg->name); |
|
1371
|
|
|
|
|
|
|
} |
|
1372
|
|
|
|
|
|
|
} else { |
|
1373
|
|
|
|
|
|
|
push @symbol_list, symbol_glob ($arg); |
|
1374
|
|
|
|
|
|
|
} |
|
1375
|
|
|
|
|
|
|
} |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
App::Chart::Download::download (symbol_list => \@symbol_list); |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
require App::Chart::LatestHandler; |
|
1380
|
|
|
|
|
|
|
App::Chart::LatestHandler->download (\@symbol_list); |
|
1381
|
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
status (''); |
|
1383
|
|
|
|
|
|
|
} |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
sub iso_to_tdate_floor { |
|
1388
|
|
|
|
|
|
|
my ($str) = @_; |
|
1389
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::iso_to_ymd ($str); |
|
1390
|
|
|
|
|
|
|
return App::Chart::ymd_to_tdate_floor ($year, $month, $day); |
|
1391
|
|
|
|
|
|
|
} |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
sub iso_to_tdate_ceil { |
|
1394
|
|
|
|
|
|
|
my ($str) = @_; |
|
1395
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::iso_to_ymd ($str); |
|
1396
|
|
|
|
|
|
|
return App::Chart::ymd_to_tdate_ceil ($year, $month, $day); |
|
1397
|
|
|
|
|
|
|
} |
|
1398
|
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
sub tdate_today { |
|
1400
|
|
|
|
|
|
|
my ($timezone) = @_; |
|
1401
|
|
|
|
|
|
|
$timezone //= App::Chart::TZ->loco; |
|
1402
|
|
|
|
|
|
|
my ($year, $month, $day) = $timezone->ymd; |
|
1403
|
|
|
|
|
|
|
return App::Chart::ymd_to_tdate_floor ($year, $month, $day); |
|
1404
|
|
|
|
|
|
|
} |
|
1405
|
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
my $default_download_tdates = 5 * 265; # 5 years |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
sub start_tdate_for_update { |
|
1409
|
|
|
|
|
|
|
my (@symbol_list) = @_; |
|
1410
|
|
|
|
|
|
|
if (! @symbol_list) { croak "start_tdate_for_update(): no symbols"; } |
|
1411
|
|
|
|
|
|
|
my $ret; |
|
1412
|
|
|
|
|
|
|
foreach my $symbol (@symbol_list) { |
|
1413
|
|
|
|
|
|
|
my $iso = App::Chart::DBI->read_single |
|
1414
|
|
|
|
|
|
|
('SELECT date FROM daily WHERE symbol=? ORDER BY date DESC LIMIT 1', |
|
1415
|
|
|
|
|
|
|
$symbol); |
|
1416
|
|
|
|
|
|
|
if (! defined $iso) { |
|
1417
|
|
|
|
|
|
|
return (tdate_today() - $default_download_tdates); |
|
1418
|
|
|
|
|
|
|
} |
|
1419
|
|
|
|
|
|
|
my $tdate = iso_to_tdate_floor ($iso) + 1; |
|
1420
|
|
|
|
|
|
|
$ret = App::Chart::min_maybe ($ret, $tdate); |
|
1421
|
|
|
|
|
|
|
} |
|
1422
|
|
|
|
|
|
|
return $ret; |
|
1423
|
|
|
|
|
|
|
} |
|
1424
|
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
sub tdate_today_after { |
|
1426
|
|
|
|
|
|
|
my ($after_hour, $after_minute, $timezone) = @_; |
|
1427
|
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
{ local $Tie::TZ::TZ = $timezone->tz; |
|
1429
|
|
|
|
|
|
|
my ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = |
|
1430
|
|
|
|
|
|
|
Date::Calc::System_Clock(); |
|
1431
|
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
my $tdate = App::Chart::ymd_to_tdate_floor ($year, $month, $day); |
|
1433
|
|
|
|
|
|
|
if ($dow <= 5 # is a weekday |
|
1434
|
|
|
|
|
|
|
&& (App::Chart::hms_to_seconds ($hour, $min, 0) |
|
1435
|
|
|
|
|
|
|
< App::Chart::hms_to_seconds ($after_hour, $after_minute, 0))) { |
|
1436
|
|
|
|
|
|
|
$tdate--; |
|
1437
|
|
|
|
|
|
|
} |
|
1438
|
|
|
|
|
|
|
return $tdate; |
|
1439
|
|
|
|
|
|
|
} |
|
1440
|
|
|
|
|
|
|
} |
|
1441
|
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1444
|
|
|
|
|
|
|
# selecting among possibly overlapping files |
|
1445
|
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
# $files is an arrayref containing hash records with keys |
|
1447
|
|
|
|
|
|
|
# |
|
1448
|
|
|
|
|
|
|
# lo_tdate,hi_tdate inclusive coverage of the record |
|
1449
|
|
|
|
|
|
|
# lo_year,hi_year alterative form for date range |
|
1450
|
|
|
|
|
|
|
# cost size of the file in bytes |
|
1451
|
|
|
|
|
|
|
# |
|
1452
|
|
|
|
|
|
|
sub choose_files { |
|
1453
|
|
|
|
|
|
|
my ($files, $lo_tdate, $hi_tdate) = @_; |
|
1454
|
|
|
|
|
|
|
if ($lo_tdate > $hi_tdate) { return []; } |
|
1455
|
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
if (DEBUG) { print "choose_files $lo_tdate to $hi_tdate\n"; } |
|
1457
|
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
foreach my $f (@$files) { |
|
1459
|
|
|
|
|
|
|
if (! defined $f->{'lo_tdate'}) { |
|
1460
|
|
|
|
|
|
|
if (my $m = $f->{'month_iso'}) { |
|
1461
|
|
|
|
|
|
|
$f->{'lo_tdate'} = App::Chart::Download::iso_to_tdate_ceil ($m); |
|
1462
|
|
|
|
|
|
|
} elsif ($f->{'lo_year'}) { |
|
1463
|
|
|
|
|
|
|
$f->{'lo_tdate'} |
|
1464
|
|
|
|
|
|
|
= App::Chart::ymd_to_tdate_ceil ($f->{'lo_year'}, 1, 1); |
|
1465
|
|
|
|
|
|
|
} else { |
|
1466
|
|
|
|
|
|
|
croak 'choose_files: missing lo date'; |
|
1467
|
|
|
|
|
|
|
} |
|
1468
|
|
|
|
|
|
|
} |
|
1469
|
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
if (! defined $f->{'hi_tdate'}) { |
|
1471
|
|
|
|
|
|
|
if (my $m = $f->{'month_iso'}) { |
|
1472
|
|
|
|
|
|
|
$f->{'hi_tdate'} |
|
1473
|
|
|
|
|
|
|
= tdate_end_of_month (App::Chart::Download::iso_to_tdate_ceil ($m)); |
|
1474
|
|
|
|
|
|
|
} elsif ($f->{'hi_year'}) { |
|
1475
|
|
|
|
|
|
|
$f->{'hi_tdate'} |
|
1476
|
|
|
|
|
|
|
= App::Chart::ymd_to_tdate_floor($f->{'hi_year'}, 12, 31); |
|
1477
|
|
|
|
|
|
|
} else { |
|
1478
|
|
|
|
|
|
|
croak 'choose_files: missing hi date'; |
|
1479
|
|
|
|
|
|
|
} |
|
1480
|
|
|
|
|
|
|
} |
|
1481
|
|
|
|
|
|
|
} |
|
1482
|
|
|
|
|
|
|
if (DEBUG >= 2) { require Data::Dumper; |
|
1483
|
|
|
|
|
|
|
print Data::Dumper::Dumper($files); } |
|
1484
|
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
# restrict wanted range to what's available |
|
1486
|
|
|
|
|
|
|
my $lo_available = min (map {$_->{'lo_tdate'}} @$files); |
|
1487
|
|
|
|
|
|
|
my $hi_available = max (map {$_->{'hi_tdate'}} @$files); |
|
1488
|
|
|
|
|
|
|
$lo_tdate = max ($lo_tdate, $lo_available); |
|
1489
|
|
|
|
|
|
|
$hi_tdate = min ($hi_tdate, $hi_available); |
|
1490
|
|
|
|
|
|
|
if (DEBUG) { print " available $lo_available to $hi_available\n"; |
|
1491
|
|
|
|
|
|
|
print " restricted range $lo_tdate to $hi_tdate\n"; } |
|
1492
|
|
|
|
|
|
|
if ($lo_tdate > $hi_tdate) { return []; } |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
# ignore file elements not covering any of the desired range |
|
1495
|
|
|
|
|
|
|
$files = [ grep {App::Chart::overlap_inclusive_p ($lo_tdate, $hi_tdate, |
|
1496
|
|
|
|
|
|
|
$_->{'lo_tdate'}, |
|
1497
|
|
|
|
|
|
|
$_->{'hi_tdate'})} |
|
1498
|
|
|
|
|
|
|
@$files ]; |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
# Algorithm::ChooseSubsets would be another way to iterate, or |
|
1501
|
|
|
|
|
|
|
# Math::Subset::List to get all combinations |
|
1502
|
|
|
|
|
|
|
my $best_cost; |
|
1503
|
|
|
|
|
|
|
my $best_files; |
|
1504
|
|
|
|
|
|
|
foreach my $this_files (all_combinations ($files)) { |
|
1505
|
|
|
|
|
|
|
if (! cover_p ($this_files, $lo_tdate, $hi_tdate)) { next; } |
|
1506
|
|
|
|
|
|
|
my $cost = List::Util::sum (map {$_->{'cost'}||0} @$this_files); |
|
1507
|
|
|
|
|
|
|
$cost += $App::Chart::option{'http_get_cost'} * scalar(@$this_files); |
|
1508
|
|
|
|
|
|
|
if (! defined $best_cost || $cost < $best_cost) { |
|
1509
|
|
|
|
|
|
|
$best_cost = $cost; |
|
1510
|
|
|
|
|
|
|
$best_files = $this_files; |
|
1511
|
|
|
|
|
|
|
} |
|
1512
|
|
|
|
|
|
|
} |
|
1513
|
|
|
|
|
|
|
return $best_files; |
|
1514
|
|
|
|
|
|
|
} |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
# return true if the set of file records in arrayref $files covers all of |
|
1517
|
|
|
|
|
|
|
# $lo_tdate through $hi_tdate inclusive |
|
1518
|
|
|
|
|
|
|
# |
|
1519
|
|
|
|
|
|
|
sub cover_p { |
|
1520
|
|
|
|
|
|
|
my ($files, $lo_tdate, $hi_tdate) = @_; |
|
1521
|
|
|
|
|
|
|
require Set::IntSpan::Fast; |
|
1522
|
|
|
|
|
|
|
my $set = Set::IntSpan::Fast->new; |
|
1523
|
|
|
|
|
|
|
foreach my $f (@$files) { |
|
1524
|
|
|
|
|
|
|
$set->add_range ($f->{'lo_tdate'}, $f->{'hi_tdate'}); |
|
1525
|
|
|
|
|
|
|
} |
|
1526
|
|
|
|
|
|
|
$set->contains_all_range ($lo_tdate, $hi_tdate); |
|
1527
|
|
|
|
|
|
|
} |
|
1528
|
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
# return a list which is all the combinations of elements of @$aref |
|
1530
|
|
|
|
|
|
|
# for example $aref == [ 10, 20 ] would return ([], [10], [20], [10,20]) |
|
1531
|
|
|
|
|
|
|
# there's 2**N combinations for aref length N |
|
1532
|
|
|
|
|
|
|
# |
|
1533
|
|
|
|
|
|
|
sub all_combinations { |
|
1534
|
|
|
|
|
|
|
my ($aref) = @_; |
|
1535
|
|
|
|
|
|
|
my @ret = ([]); |
|
1536
|
|
|
|
|
|
|
foreach my $i (0 .. $#$aref) { |
|
1537
|
|
|
|
|
|
|
push @ret, map {[ @$_, $aref->[$i] ]} @ret; |
|
1538
|
|
|
|
|
|
|
} |
|
1539
|
|
|
|
|
|
|
return @ret; |
|
1540
|
|
|
|
|
|
|
} |
|
1541
|
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
# return the last tdate in the month containing the given $tdate |
|
1543
|
|
|
|
|
|
|
sub tdate_end_of_month { |
|
1544
|
|
|
|
|
|
|
my ($tdate) = @_; |
|
1545
|
|
|
|
|
|
|
my ($year, $month, $day) = App::Chart::tdate_to_ymd ($tdate); |
|
1546
|
|
|
|
|
|
|
($year, $month, $day) = Date::Calc::Add_Delta_YM ($year, $month, $day, 0,1); |
|
1547
|
|
|
|
|
|
|
$day = 1; |
|
1548
|
|
|
|
|
|
|
($year, $month, $day) = Date::Calc::Add_Delta_Days ($year, $month, $day, -1); |
|
1549
|
|
|
|
|
|
|
return App::Chart::ymd_to_tdate_floor ($year, $month, $day); |
|
1550
|
|
|
|
|
|
|
} |
|
1551
|
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
1; |
|
1553
|
|
|
|
|
|
|
__END__ |
|
1554
|
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
=for stopwords url TTY LF whitespace undef YYYY-MM-DD GBP ISIN tdate |
|
1556
|
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
=head1 NAME |
|
1558
|
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
App::Chart::Download -- download functions |
|
1560
|
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
=cut |
|
1562
|
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
# =head1 HTTP FUNCTIONS |
|
1564
|
|
|
|
|
|
|
# |
|
1565
|
|
|
|
|
|
|
# =over 4 |
|
1566
|
|
|
|
|
|
|
# |
|
1567
|
|
|
|
|
|
|
# =item C<< $resp = App::Chart::Download->get ($url, key=>value,...) >> |
|
1568
|
|
|
|
|
|
|
# |
|
1569
|
|
|
|
|
|
|
# Download the given C<$url> and return a C<HTTP::Response> object. The |
|
1570
|
|
|
|
|
|
|
# following key/value options are accepted. |
|
1571
|
|
|
|
|
|
|
# |
|
1572
|
|
|
|
|
|
|
# method default 'GET' |
|
1573
|
|
|
|
|
|
|
# data body data for the request |
|
1574
|
|
|
|
|
|
|
# etag from previous get of this url |
|
1575
|
|
|
|
|
|
|
# last_modified from previous get of this url |
|
1576
|
|
|
|
|
|
|
# |
|
1577
|
|
|
|
|
|
|
# A C<"POST"> can be done by setting C<method> accordingly and passing |
|
1578
|
|
|
|
|
|
|
# C<data>. C<etag> and/or C<last_modified> can be given to avoid a |
|
1579
|
|
|
|
|
|
|
# re-download of url if unchanged (response status 304). |
|
1580
|
|
|
|
|
|
|
# |
|
1581
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::status ($str, $str, ...) >> |
|
1582
|
|
|
|
|
|
|
# |
|
1583
|
|
|
|
|
|
|
# Join the argument strings together, with spaces between, and print them as |
|
1584
|
|
|
|
|
|
|
# the current download status. Subsequent HTTP downloads through |
|
1585
|
|
|
|
|
|
|
# C<App::Chart::UserAgent> will append their progress to this status too. |
|
1586
|
|
|
|
|
|
|
# |
|
1587
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::download_message ($str, $str, ...) >> |
|
1588
|
|
|
|
|
|
|
# |
|
1589
|
|
|
|
|
|
|
# Join the argument strings together, with spaces between, and print them and |
|
1590
|
|
|
|
|
|
|
# a newline as a download message. This differs from an ordinary C<print> in |
|
1591
|
|
|
|
|
|
|
# that on a TTY it first erases anything from C<status> above (or checks the |
|
1592
|
|
|
|
|
|
|
# message itself is long enough to overwrite). |
|
1593
|
|
|
|
|
|
|
# |
|
1594
|
|
|
|
|
|
|
# =back |
|
1595
|
|
|
|
|
|
|
# |
|
1596
|
|
|
|
|
|
|
# =head1 PARSING FUNCTIONS |
|
1597
|
|
|
|
|
|
|
# |
|
1598
|
|
|
|
|
|
|
# =over 4 |
|
1599
|
|
|
|
|
|
|
# |
|
1600
|
|
|
|
|
|
|
# =item App::Chart::Download::split_lines ($str) |
|
1601
|
|
|
|
|
|
|
# |
|
1602
|
|
|
|
|
|
|
# Return a list of the lines in C<$str> separated by CR or LF, with trailing |
|
1603
|
|
|
|
|
|
|
# whitespace stripped, and blank lines (entirely whitespace) removed. |
|
1604
|
|
|
|
|
|
|
# |
|
1605
|
|
|
|
|
|
|
# =item App::Chart::Download::trim_decimals ($str, $want_decimals) |
|
1606
|
|
|
|
|
|
|
# |
|
1607
|
|
|
|
|
|
|
# Return C<$str> with trailing zero decimal places trimmed off to leave |
|
1608
|
|
|
|
|
|
|
# C<$want_decimals>. If C<$str> doesn't look like a number, or is undef, then |
|
1609
|
|
|
|
|
|
|
# it's returned unchanged. |
|
1610
|
|
|
|
|
|
|
# |
|
1611
|
|
|
|
|
|
|
# =item App::Chart::Download::str_is_zero ($str) |
|
1612
|
|
|
|
|
|
|
# |
|
1613
|
|
|
|
|
|
|
# Return true if C<$str> is a zero number, like "0", "00", "0.00", ".000". |
|
1614
|
|
|
|
|
|
|
# |
|
1615
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::cents_to_dollars ($str) >> |
|
1616
|
|
|
|
|
|
|
# |
|
1617
|
|
|
|
|
|
|
# C<$str> is a number like "12.5" in cents. Return it with the decimal point |
|
1618
|
|
|
|
|
|
|
# shifted to be expressed in dollars like "0.125". |
|
1619
|
|
|
|
|
|
|
# |
|
1620
|
|
|
|
|
|
|
# =back |
|
1621
|
|
|
|
|
|
|
# |
|
1622
|
|
|
|
|
|
|
# =head1 DATE/TIME FUNCTIONS |
|
1623
|
|
|
|
|
|
|
# |
|
1624
|
|
|
|
|
|
|
# =over 4 |
|
1625
|
|
|
|
|
|
|
# |
|
1626
|
|
|
|
|
|
|
# =item App::Chart::Download::month_to_nearest_year ($month) |
|
1627
|
|
|
|
|
|
|
# |
|
1628
|
|
|
|
|
|
|
# C<$month> is in the range 1 to 12. Return a year, as a number like 2007, to |
|
1629
|
|
|
|
|
|
|
# go with that month, so that the combination is within +/- 6 months of today. |
|
1630
|
|
|
|
|
|
|
# |
|
1631
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::Decode_Date_EU_to_iso ($str) >> |
|
1632
|
|
|
|
|
|
|
# |
|
1633
|
|
|
|
|
|
|
# Decode a date in the form day/month/year using |
|
1634
|
|
|
|
|
|
|
# C<Date::Calc::Decode_Date_EU>, and return an ISO format date string like |
|
1635
|
|
|
|
|
|
|
# "2007-10-26". |
|
1636
|
|
|
|
|
|
|
# |
|
1637
|
|
|
|
|
|
|
# =item App::Chart::Download::Decode_Date_YMD ($str) |
|
1638
|
|
|
|
|
|
|
# |
|
1639
|
|
|
|
|
|
|
# Decode a date in the form year/month/day and return C<($year, $month, |
|
1640
|
|
|
|
|
|
|
# $day)>, similar to what C<Date::Calc> does. |
|
1641
|
|
|
|
|
|
|
# |
|
1642
|
|
|
|
|
|
|
# The month given can be a number or a name in English and is always returned |
|
1643
|
|
|
|
|
|
|
# as a number. Any separator can be used between the components and leading |
|
1644
|
|
|
|
|
|
|
# and trailing whitespace is ignored. If the string is unrecognised the |
|
1645
|
|
|
|
|
|
|
# return is an empty list C<()>. |
|
1646
|
|
|
|
|
|
|
# |
|
1647
|
|
|
|
|
|
|
# =item App::Chart::Download::Decode_Date_YMD_to_iso ($str) |
|
1648
|
|
|
|
|
|
|
# |
|
1649
|
|
|
|
|
|
|
# Decode a date using C<App::Chart::Download::Decode_Date_YMD> above and return |
|
1650
|
|
|
|
|
|
|
# an ISO format string "YYYY-MM-DD". An error is thrown if C<$str> is |
|
1651
|
|
|
|
|
|
|
# invalid. |
|
1652
|
|
|
|
|
|
|
# |
|
1653
|
|
|
|
|
|
|
# =item App::Chart::Download::date_parse_to_iso ($str) |
|
1654
|
|
|
|
|
|
|
# |
|
1655
|
|
|
|
|
|
|
# unused? |
|
1656
|
|
|
|
|
|
|
# |
|
1657
|
|
|
|
|
|
|
# Apply Date::Parse::strptime() to C<$str> and return an ISO format date |
|
1658
|
|
|
|
|
|
|
# string like "2007-10-26" for the result. An error is thrown if C<$str> is |
|
1659
|
|
|
|
|
|
|
# unrecognisable. |
|
1660
|
|
|
|
|
|
|
# |
|
1661
|
|
|
|
|
|
|
# =back |
|
1662
|
|
|
|
|
|
|
# |
|
1663
|
|
|
|
|
|
|
# =item weekday_date_after_time ($hour,$min, $timezone, [$offset]) |
|
1664
|
|
|
|
|
|
|
# |
|
1665
|
|
|
|
|
|
|
# Return an an ISO format date string like C<"2008-08-20"> which is a weekday, |
|
1666
|
|
|
|
|
|
|
# giving today on a weekday after C<$hour>,C<$min>, or the previous weekday if |
|
1667
|
|
|
|
|
|
|
# before that time or any time on a weekend. |
|
1668
|
|
|
|
|
|
|
# |
|
1669
|
|
|
|
|
|
|
# C<$offset> is a number of weekdays to step forward (or negative for back) on |
|
1670
|
|
|
|
|
|
|
# the return value. |
|
1671
|
|
|
|
|
|
|
# |
|
1672
|
|
|
|
|
|
|
# For example if today's trading data is available after 5pm then a call like |
|
1673
|
|
|
|
|
|
|
# |
|
1674
|
|
|
|
|
|
|
# weekday_date_after_time (17,0, $my_zone) |
|
1675
|
|
|
|
|
|
|
# |
|
1676
|
|
|
|
|
|
|
# would give yesterday until 5pm, and today after that, and give Friday all |
|
1677
|
|
|
|
|
|
|
# through the weekend. If trading data is not available until 9am the |
|
1678
|
|
|
|
|
|
|
# following weekday then a call like |
|
1679
|
|
|
|
|
|
|
# |
|
1680
|
|
|
|
|
|
|
# weekday_date_after_time (9,0, $my_zone, -1) |
|
1681
|
|
|
|
|
|
|
# |
|
1682
|
|
|
|
|
|
|
# would return the day before yesterday until 9am, and yesterday after that, |
|
1683
|
|
|
|
|
|
|
# including returning Thursday all through the weekend. |
|
1684
|
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
# =head1 DATABASE FUNCTIONS |
|
1686
|
|
|
|
|
|
|
# |
|
1687
|
|
|
|
|
|
|
# =over 4 |
|
1688
|
|
|
|
|
|
|
# |
|
1689
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::write_daily_group ($hashref) >> |
|
1690
|
|
|
|
|
|
|
# |
|
1691
|
|
|
|
|
|
|
# C<$hashref> is daily share price data. Write it to the database. The |
|
1692
|
|
|
|
|
|
|
# fields of C<$hashref> are as follows. They are variously crunched to |
|
1693
|
|
|
|
|
|
|
# normalize and validate before being written to the database. |
|
1694
|
|
|
|
|
|
|
# |
|
1695
|
|
|
|
|
|
|
# =over |
|
1696
|
|
|
|
|
|
|
# |
|
1697
|
|
|
|
|
|
|
# =item C<data> |
|
1698
|
|
|
|
|
|
|
# |
|
1699
|
|
|
|
|
|
|
# Arrayref containing hashref records with fields |
|
1700
|
|
|
|
|
|
|
# |
|
1701
|
|
|
|
|
|
|
# symbol string |
|
1702
|
|
|
|
|
|
|
# open price |
|
1703
|
|
|
|
|
|
|
# high price |
|
1704
|
|
|
|
|
|
|
# low price |
|
1705
|
|
|
|
|
|
|
# close price |
|
1706
|
|
|
|
|
|
|
# volume number |
|
1707
|
|
|
|
|
|
|
# openint number |
|
1708
|
|
|
|
|
|
|
# |
|
1709
|
|
|
|
|
|
|
# Any C<symbol> not already in the database is ignored. |
|
1710
|
|
|
|
|
|
|
# |
|
1711
|
|
|
|
|
|
|
# =item C<dividends> |
|
1712
|
|
|
|
|
|
|
# |
|
1713
|
|
|
|
|
|
|
# symbol string |
|
1714
|
|
|
|
|
|
|
# |
|
1715
|
|
|
|
|
|
|
# Any C<symbol> not already in the database is ignored. |
|
1716
|
|
|
|
|
|
|
# |
|
1717
|
|
|
|
|
|
|
# =item C<splits> |
|
1718
|
|
|
|
|
|
|
# |
|
1719
|
|
|
|
|
|
|
# symbol string |
|
1720
|
|
|
|
|
|
|
# |
|
1721
|
|
|
|
|
|
|
# Any C<symbol> not already in the database is ignored. |
|
1722
|
|
|
|
|
|
|
# |
|
1723
|
|
|
|
|
|
|
# =item C<names> |
|
1724
|
|
|
|
|
|
|
# |
|
1725
|
|
|
|
|
|
|
# =item C<currencies> |
|
1726
|
|
|
|
|
|
|
# |
|
1727
|
|
|
|
|
|
|
# =back |
|
1728
|
|
|
|
|
|
|
# |
|
1729
|
|
|
|
|
|
|
# |
|
1730
|
|
|
|
|
|
|
# |
|
1731
|
|
|
|
|
|
|
# =item App::Chart::Download::write_latest_group ($hashref) |
|
1732
|
|
|
|
|
|
|
# |
|
1733
|
|
|
|
|
|
|
# ... |
|
1734
|
|
|
|
|
|
|
# |
|
1735
|
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
# =item App::Chart::Download::crunch_number ($str) |
|
1737
|
|
|
|
|
|
|
# |
|
1738
|
|
|
|
|
|
|
# =item App::Chart::Download::crunch_price ($price, $prefer_decimals) |
|
1739
|
|
|
|
|
|
|
# |
|
1740
|
|
|
|
|
|
|
# =item App::Chart::Download::crunch_change ($change, $prefer_decimals) |
|
1741
|
|
|
|
|
|
|
# |
|
1742
|
|
|
|
|
|
|
# ... |
|
1743
|
|
|
|
|
|
|
# |
|
1744
|
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
# =item App::Chart::Download::set_symbol_name ($symbol, $name) |
|
1746
|
|
|
|
|
|
|
# |
|
1747
|
|
|
|
|
|
|
# Set the company or commodity name recorded in the database for C<$symbol>, |
|
1748
|
|
|
|
|
|
|
# if C<$symbol> is already in the database. |
|
1749
|
|
|
|
|
|
|
# |
|
1750
|
|
|
|
|
|
|
# =item App::Chart::Download::set_currency ($symbol, $currency) |
|
1751
|
|
|
|
|
|
|
# |
|
1752
|
|
|
|
|
|
|
# Set the currency recorded in the database for C<$symbol>, if C<$symbol> is |
|
1753
|
|
|
|
|
|
|
# already in the database. C<$currency> should be a three-letter currency |
|
1754
|
|
|
|
|
|
|
# code, like "GBP" for British Pounds. |
|
1755
|
|
|
|
|
|
|
# |
|
1756
|
|
|
|
|
|
|
# =item App::Chart::Download::set_isin ($symbol, $isin) |
|
1757
|
|
|
|
|
|
|
# |
|
1758
|
|
|
|
|
|
|
# Set the ISIN recorded in the database for C<$symbol>, if C<$symbol> is |
|
1759
|
|
|
|
|
|
|
# already in the database. |
|
1760
|
|
|
|
|
|
|
# |
|
1761
|
|
|
|
|
|
|
# =item App::Chart::Download::set_decimals ($symbol, $decimals) |
|
1762
|
|
|
|
|
|
|
# |
|
1763
|
|
|
|
|
|
|
# Set the number of decimals to show for prices of C<$symbol>, if C<$symbol> |
|
1764
|
|
|
|
|
|
|
# is already in the database. |
|
1765
|
|
|
|
|
|
|
# |
|
1766
|
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
# =item download (key=>value, ...) |
|
1769
|
|
|
|
|
|
|
# |
|
1770
|
|
|
|
|
|
|
# ... |
|
1771
|
|
|
|
|
|
|
# |
|
1772
|
|
|
|
|
|
|
# =cut |
|
1773
|
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
# =item C<< App::Chart::Download::start_tdate_for_update ($symbol, ...) >> |
|
1775
|
|
|
|
|
|
|
# |
|
1776
|
|
|
|
|
|
|
# Return the tdate to start at for a data update of all the given symbols. |
|
1777
|
|
|
|
|
|
|
# This is the day after existing data of the oldest, or five years ago if any |
|
1778
|
|
|
|
|
|
|
# need an initial download. |
|
1779
|
|
|
|
|
|
|
# |
|
1780
|
|
|
|
|
|
|
# =cut |
|
1781
|
|
|
|
|
|
|
|