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
|
|
610
|
use 5.010; |
|
2
|
|
|
|
|
8
|
|
21
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
53
|
|
22
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
52
|
|
23
|
2
|
|
|
2
|
|
8
|
use Carp 'carp','croak'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
106
|
|
24
|
2
|
|
|
2
|
|
518
|
use Date::Calc; |
|
2
|
|
|
|
|
8941
|
|
|
2
|
|
|
|
|
71
|
|
25
|
2
|
|
|
2
|
|
11
|
use List::Util qw(min max); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
118
|
|
26
|
2
|
|
|
2
|
|
365
|
use List::MoreUtils; |
|
2
|
|
|
|
|
8846
|
|
|
2
|
|
|
|
|
18
|
|
27
|
2
|
|
|
2
|
|
1853
|
use Regexp::Common 'whitespace'; |
|
2
|
|
|
|
|
4043
|
|
|
2
|
|
|
|
|
7
|
|
28
|
2
|
|
|
2
|
|
1691
|
use Locale::TextDomain ('App-Chart'); |
|
2
|
|
|
|
|
17244
|
|
|
2
|
|
|
|
|
13
|
|
29
|
|
|
|
|
|
|
|
30
|
2
|
|
|
2
|
|
6221
|
use PerlIO::via::EscStatus; |
|
2
|
|
|
|
|
22276
|
|
|
2
|
|
|
|
|
75
|
|
31
|
2
|
|
|
2
|
|
499
|
use Tie::TZ; |
|
2
|
|
|
|
|
823
|
|
|
2
|
|
|
|
|
69
|
|
32
|
|
|
|
|
|
|
|
33
|
2
|
|
|
2
|
|
639
|
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
|
|
|
|
|
|
|
|