File Coverage

blib/lib/App/Chart/Download.pm
Criterion Covered Total %
statement 33 35 94.2
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 45 47 95.7


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