File Coverage

blib/lib/Finance/Calendar.pm
Criterion Covered Total %
statement 304 317 95.9
branch 111 142 78.1
condition 52 90 57.7
subroutine 43 43 100.0
pod 24 24 100.0
total 534 616 86.6


line stmt bran cond sub pod time code
1             package Finance::Calendar;
2              
3             =head1 NAME
4              
5             Finance::Calendar - represents the trading calendar.
6              
7             =head1 SYNOPSIS
8              
9             use Finance::Calendar;
10             use Date::Utility;
11              
12             my $calendar = {
13             holidays => {
14             "25-Dec-2013" => {
15             "Christmas Day" => [qw(FOREX METAL)],
16             },
17             "1-Jan-2014" => {
18             "New Year's Day" => [qw( FOREX METAL)],
19             },
20             "1-Apr-2013" => {
21             "Easter Monday" => [qw( USD)],
22             },
23             },
24             early_closes => {
25             '24-Dec-2009' => {
26             '16:30' => ['HKSE'],
27             },
28             '22-Dec-2016' => {
29             '18:00' => ['FOREX', 'METAL'],
30             },
31             },
32             late_opens => {
33             '24-Dec-2010' => {
34             '14:30' => ['HKSE'],
35             },
36             },
37             };
38             my $calendar = Finance::Calendar->new(calendar => $calendar);
39             my $now = Date::Utility->new;
40              
41             # Does London Stocks Exchange trade on $now
42             $calendar->trades_on(Finance::Exchange->create_exchange('LSE'), $now);
43              
44             # Is it a country holiday for the United States on $now
45             $calendar->is_holiday_for('USD', $now);
46              
47             # Returns the opening time of Australian Stocks Exchange on $now
48             $calendar->opening_on(Finance::Exchange->create_exchange('ASX'), $now);
49              
50             # Returns the closing time of Forex on $now
51             $calendar->closing_on(Finance::Exchange->create_exchange('FOREX'), $now);
52             ...
53              
54             =head1 DESCRIPTION
55              
56             This class is responsible for providing trading times or holidays related information of a given financial stock exchange on a specific date.
57              
58             =cut
59              
60 1     1   789827 use Moose;
  1         11  
  1         6  
61              
62             our $VERSION = '0.05';
63              
64 1     1   7105 use List::Util qw(min max first);
  1         2  
  1         68  
65 1     1   611 use Date::Utility;
  1         766403  
  1         57  
66 1     1   936 use Memoize;
  1         2746  
  1         56  
67 1     1   8 use Finance::Exchange;
  1         3  
  1         28  
68 1     1   5 use Carp qw(croak);
  1         2  
  1         4457  
69              
70             =head1 ATTRIBUTES - Object Construction
71              
72             =head2 calendar
73              
74             A hash reference that has information on:
75             - exchange and country holidays
76             - late opens
77             - early closes
78              
79             =cut
80              
81             has calendar => (
82             is => 'ro',
83             required => 1,
84             );
85              
86             has _cache => (
87             is => 'ro',
88             default => sub { {} },
89             );
90              
91             sub _get_cache {
92 542     542   1168 my ($self, $method_name, $exchange, @dates) = @_;
93              
94 542 100       14475 return undef unless exists $self->_cache->{$method_name};
95              
96 534         12418 my $key = join "_", ($exchange->symbol, (map { $self->trading_date_for($exchange, $_)->epoch } @dates));
  538         4099  
97 534         40953 return $self->_cache->{$method_name}{$key};
98             }
99              
100             sub _set_cache {
101 211     211   527 my ($self, $value, $method_name, $exchange, @dates) = @_;
102              
103 211         5364 my $key = join "_", ($exchange->symbol, (map { $self->trading_date_for($exchange, $_)->epoch } @dates));
  217         2019  
104 211         14397 $self->_cache->{$method_name}{$key} = $value;
105              
106 211         447 return undef;
107             }
108              
109             =head1 METHODS - TRADING DAYS RELATED
110              
111             =head2 trades_on
112              
113             ->trades_on($exchange_object, $date_object);
114              
115             Returns true if trading is done on the day of a given Date::Utility.
116              
117             =cut
118              
119             sub trades_on {
120 320     320 1 4542 my ($self, $exchange, $when) = @_;
121              
122 320 100       671 if (my $cache = $self->_get_cache('trades_on', $exchange, $when)) {
123 208         613 return $cache;
124             }
125              
126 112         284 my $really_when = $self->trading_date_for($exchange, $when);
127 112 100 100     5435 my $result = (@{$exchange->trading_days_list}[$really_when->day_of_week] && !$self->is_holiday_for($exchange->symbol, $really_when)) ? 1 : 0;
128              
129 112         774 $self->_set_cache($result, 'trades_on', $exchange, $when);
130 112         368 return $result;
131             }
132              
133             =head2 trade_date_before
134              
135             ->trade_date_before($exchange_object, $date_object);
136              
137             Returns a Date::Utility object for the previous trading day of an exchange for the given date.
138              
139             =cut
140              
141             sub trade_date_before {
142 5     5 1 7978 my ($self, $exchange, $when) = @_;
143              
144 5         14 my $begin = $self->trading_date_for($exchange, $when);
145              
146 5 50       95 if (my $cache = $self->_get_cache('trade_date_before', $exchange, $begin)) {
147 0         0 return $cache;
148             }
149              
150 5         10 my $date_behind;
151 5         7 my $counter = 1;
152              
153             # look back at most 10 days. The previous trading day could have span over a weekend with multiple consecutive holidays.
154             # Previously it was 7 days, but need to increase a little bit since there is a case
155             # where the holidays was more than 7. That was during end of ramadhan at Saudi Arabia Exchange.
156 5   66     24 while (not $date_behind and $counter < 10) {
157 8         31 my $possible = $begin->minus_time_interval($counter . 'd');
158 8 100       647 $date_behind = $possible if $self->trades_on($exchange, $possible);
159 8         31 $counter++;
160             }
161              
162 5         12 $self->_set_cache($date_behind, 'trade_date_before', $exchange, $begin);
163 5         130 return $date_behind;
164             }
165              
166             =head2 trade_date_after
167              
168             ->trade_date_after($exchange_object, $date_object);
169              
170             Returns a Date::Utility object of the next trading day of an exchange for a given date.
171              
172             =cut
173              
174             sub trade_date_after {
175 19     19 1 9632 my ($self, $exchange, $date) = @_;
176              
177 19         30 my $date_next;
178 19         29 my $counter = 1;
179 19         44 my $begin = $self->trading_date_for($exchange, $date);
180              
181 19 100       775 if (my $cache = $self->_get_cache('trade_date_after', $exchange, $begin)) {
182 2         18 return $cache;
183             }
184              
185             # look forward at most 11 days. The next trading day could have span over a weekend with multiple consecutive holidays.
186             # We chosed 11 due to the fact that the longest trading holidays we have got so far was 10 days(TSE).
187 17   66     94 while (not $date_next and $counter <= 11) {
188 30         116 my $possible = $begin->plus_time_interval($counter . 'd');
189 30 100       4735 $date_next = $possible if $self->trades_on($exchange, $possible);
190 30         115 $counter++;
191             }
192              
193 17         77 $self->_set_cache($date_next, 'trade_date_after', $exchange, $begin);
194 17         179 return $date_next;
195             }
196              
197             =head2 trading_date_for
198              
199             ->trading_date_for($exchange_object, $date_object);
200              
201             The date on which trading is considered to be taking place even if it is not the same as the GMT date.
202             Note that this does not handle trading dates are offset forward beyond the next day (24h). It will need additional work if these are found to exist.
203              
204             Returns a Date object representing midnight GMT of the trading date.
205              
206             =cut
207              
208             sub trading_date_for {
209 1037     1037 1 4432 my ($self, $exchange, $date) = @_;
210              
211             # if there's no pre-midnight open, then returns the same day.
212 1037 100       26344 return $date->truncate_to_day unless ($exchange->trading_date_can_differ);
213              
214 35         1158 my $next_day = $date->plus_time_interval('1d')->truncate_to_day;
215             my $open_ti =
216 35         5811 $exchange->market_times->{$self->_times_dst_key($exchange, $next_day)}->{daily_open};
217              
218 35 100 66     2971 return $next_day if ($open_ti and $next_day->epoch + $open_ti->seconds <= $date->epoch);
219 34         1665 return $date->truncate_to_day;
220             }
221              
222             =head2 calendar_days_to_trade_date_after
223              
224             ->calendar_days_to_trade_date_after($exchange_object, $date_object);
225              
226             Returns the number of calendar days between a given Date::Utility
227             and the next day on which trading is open.
228              
229             =cut
230              
231             sub calendar_days_to_trade_date_after {
232 6     6 1 4854 my ($self, $exchange, $when) = @_;
233              
234 6 50       20 if (my $cache = $self->_get_cache('calendar_days_to_trade_date_after', $exchange, $when)) {
235 0         0 return $cache;
236             }
237              
238 6         21 my $number_of_days = $self->trade_date_after($exchange, $when)->days_between($when);
239              
240 6         633 $self->_set_cache($number_of_days, 'calendar_days_to_trade_date_after', $exchange, $when);
241 6         51 return $number_of_days;
242             }
243              
244             =head2 trading_days_between
245              
246              
247             ->trading_days_between($exchange_object, Date::Utility->new('4-May-10'),Date::Utility->new('5-May-10'));
248              
249             Returns the number of trading days _between_ two given dates.
250              
251             =cut
252              
253             sub trading_days_between {
254 4     4 1 5515 my ($self, $exchange, $begin, $end) = @_;
255              
256 4 50       13 if (my $cache = $self->_get_cache('trading_days_between', $exchange, $begin, $end)) {
257 0         0 return $cache;
258             }
259              
260             # Count up how many are trading days.
261 4         8 my $number_of_days = scalar grep { $self->trades_on($exchange, $_) } @{$self->_days_between($begin, $end)};
  6         52  
  4         70  
262              
263 4         61 $self->_set_cache($number_of_days, 'trading_days_between', $exchange, $begin, $end);
264 4         19 return $number_of_days;
265             }
266              
267             =head2 holiday_days_between
268              
269             ->holiday_days_between($exchange_object, Date::Utility->new('4-May-10'),Date::Utility->new('5-May-10'));
270              
271             Returns the number of holidays _between_ two given dates.
272              
273             =cut
274              
275             sub holiday_days_between {
276 2     2 1 4398 my ($self, $exchange, $begin, $end) = @_;
277              
278 2 50       9 if (my $cache = $self->_get_cache('holiday_days_between', $exchange, $begin, $end)) {
279 0         0 return $cache;
280             }
281              
282             # Count up how many are trading days.
283 2         4 my $number_of_days = scalar grep { $self->is_holiday_for($exchange->symbol, $_) } @{$self->_days_between($begin, $end)};
  11         311  
  2         35  
284              
285 2         13 $self->_set_cache($number_of_days, 'holiday_days_between', $exchange, $begin, $end);
286 2         14 return $number_of_days;
287             }
288              
289             =head1 METHODS - TRADING TIMES RELATED.
290              
291             =head2 is_open
292              
293             ->is_open($exchange_object);
294              
295             Returns true is exchange is open now, false otherwise.
296              
297             =cut
298              
299             sub is_open {
300 1     1 1 12320 my ($self, $exchange) = @_;
301              
302 1         7 return $self->is_open_at($exchange, Date::Utility->new);
303             }
304              
305             =head2 is_open_at
306              
307             ->is_open_at($exchange_object, $epoch);
308              
309             Return true is exchange is open at the given epoch, false otherwise.
310              
311             =cut
312              
313             sub is_open_at {
314 17     17 1 6402 my ($self, $exchange, $date) = @_;
315 17         44 my $opening = $self->opening_on($exchange, $date);
316 17 100 100     102 return undef if (not $opening or $self->_is_in_trading_break($exchange, $date));
317 14 100 100     42 return 1 if (not $date->is_before($opening) and not $date->is_after($self->closing_on($exchange, $date)));
318             # if everything falls through, assume it is not open
319 11         136 return undef;
320             }
321              
322             =head2 seconds_since_open_at
323              
324             ->seconds_since_open_at($exchange_object, $epoch);
325              
326             Returns the number of seconds since the exchange opened from the given epoch.
327              
328             =cut
329              
330             sub seconds_since_open_at {
331 5     5 1 287 my ($self, $exchange, $date) = @_;
332              
333 5         15 return $self->_market_opens($exchange, $date)->{'opened'};
334             }
335              
336             =head2 seconds_since_close_at
337              
338             ->seconds_since_close_at($exchange_object, $epoch);
339              
340             Returns the number of seconds since the exchange closed from the given epoch.
341              
342             =cut
343              
344             sub seconds_since_close_at {
345 5     5 1 3562 my ($self, $exchange, $date) = @_;
346              
347 5         12 return $self->_market_opens($exchange, $date)->{'closed'};
348             }
349              
350             =head2 opening_on
351              
352             ->opening_on($exchange_object, Date::Utility->new('25-Dec-10')); # returns undef (given Xmas is a holiday)
353              
354             Returns the opening time (Date::Utility) of the exchange for a given Date::Utility, undefined otherwise.
355              
356             =cut
357              
358             sub opening_on {
359 108     108 1 3956 my ($self, $exchange, $when) = @_;
360              
361 108 100       215 if (my $cache = $self->_get_cache('opening_on', $exchange, $when)) {
362 68         989 return $cache;
363             }
364              
365 40   100     115 my $opening_on = $self->opens_late_on($exchange, $when) // $self->get_exchange_open_times($exchange, $when, 'daily_open');
366              
367 40         127 $self->_set_cache($opening_on, 'opening_on', $exchange, $when);
368 40         285 return $opening_on;
369             }
370              
371             =head2 closing_on
372              
373             ->closing_on($exchange_object, Date::Utility->new('25-Dec-10')); # returns undef (given Xmas is a holiday)
374              
375             Returns the closing time (Date::Utility) of the exchange for a given Date::Utility, undefined otherwise.
376              
377             =cut
378              
379             sub closing_on {
380 78     78 1 4365 my ($self, $exchange, $when) = @_;
381              
382 78 100       147 if (my $cache = $self->_get_cache('closing_on', $exchange, $when)) {
383 53         920 return $cache;
384             }
385              
386 25   100     62 my $closing_on = $self->closes_early_on($exchange, $when) // $self->get_exchange_open_times($exchange, $when, 'daily_close');
387              
388 25         84 $self->_set_cache($closing_on, 'closing_on', $exchange, $when);
389 25         268 return $closing_on;
390             }
391              
392             =head2 trading_breaks
393              
394             ->trading_breaks($exchange_object, $date_object);
395              
396             Defines the breaktime for this exchange.
397              
398             =cut
399              
400             sub trading_breaks {
401 81     81 1 2322 my ($self, $exchange, $when) = @_;
402              
403 81         176 return $self->get_exchange_open_times($exchange, $when, 'trading_breaks');
404             }
405              
406             =head2 regularly_adjusts_trading_hours_on
407              
408             Returns a hashref of special-case changes that may apply on specific
409             trading days. Currently, this applies on Fridays only:
410              
411             =over 4
412              
413              
414             =item * for forex or metals
415              
416             =back
417              
418             Example:
419              
420             $calendar->regularly_adjusts_trading_hours_on('FOREX', time);
421              
422             =cut
423              
424             sub regularly_adjusts_trading_hours_on {
425 57     57 1 8323 my ($self, $exchange, $when) = @_;
426              
427             # Only applies on Fridays
428 57 100       1343 return undef if $when->day_of_week != 5;
429              
430 19         426 my $changes;
431              
432 19         38 my $rule = 'Fridays';
433 19 100 100     440 if ($exchange->symbol eq 'FOREX' or $exchange->symbol eq 'METAL') {
434 4         107 $changes = {
435             'daily_close' => {
436             to => '20h55m',
437             rule => $rule,
438             }};
439             }
440              
441 19         609 return $changes;
442             }
443              
444             =head2 closes_early_on
445              
446             ->closes_early_on($exchange_object, $date_object);
447              
448             Returns the closing time as a L<Date::Utility> instance if the exchange closes early on the given date,
449             or C<undef>.
450              
451             =cut
452              
453             sub closes_early_on {
454 31     31 1 6378 my ($self, $exchange, $when) = @_;
455              
456 31 100       64 return undef unless $self->trades_on($exchange, $when);
457              
458 27         41 my $closes_early;
459 27         77 my $listed = $self->_get_partial_trading_for($exchange, 'early_closes', $when);
460 27 100       112 if ($listed) {
    100          
461 3         14 $closes_early = $when->truncate_to_day->plus_time_interval($listed);
462             } elsif (my $scheduled_changes = $self->regularly_adjusts_trading_hours_on($exchange, $when)) {
463             $closes_early = $when->truncate_to_day->plus_time_interval($scheduled_changes->{daily_close}->{to})
464 2 50       18 if ($scheduled_changes->{daily_close});
465             }
466              
467 27         1158 return $closes_early;
468             }
469              
470             =head2 opens_late_on
471              
472             ->opens_late_on($exchange_object, $date_object);
473              
474             Returns true if the exchange opens late on the given date.
475              
476             =cut
477              
478             sub opens_late_on {
479 44     44 1 1283 my ($self, $exchange, $when) = @_;
480              
481 44 100       101 return undef unless $self->trades_on($exchange, $when);
482              
483 31         46 my $opens_late;
484 31         84 my $listed = $self->_get_partial_trading_for($exchange, 'late_opens', $when);
485 31 100       156 if ($listed) {
    50          
486 2         12 $opens_late = $when->truncate_to_day->plus_time_interval($listed);
487             } elsif (my $scheduled_changes = $self->regularly_adjusts_trading_hours_on($exchange, $when)) {
488             $opens_late = $when->truncate_to_day->plus_time_interval($scheduled_changes->{daily_open}->{to})
489 0 0       0 if ($scheduled_changes->{daily_open});
490             }
491              
492 31         917 return $opens_late;
493             }
494              
495             =head2 seconds_of_trading_between_epochs
496              
497             ->seconds_of_trading_between_epochs($exchange_object, $epoch1, $epoch2);
498              
499             Get total number of seconds of trading time between two epochs accounting for breaks.
500              
501             =cut
502              
503             my $full_day = 86400;
504              
505             sub seconds_of_trading_between_epochs {
506 22     22 1 28738 my ($self, $exchange, $start, $end) = @_;
507              
508 22         665 my ($start_epoch, $end_epoch) = ($start->epoch, $end->epoch);
509 22         238 my $result = 0;
510              
511             # step 1: calculate non-cached incomplete start-day and end_dates
512 22         45 my $day_start = $start_epoch - ($start_epoch % $full_day);
513 22         32 my $day_end = $end_epoch - ($end_epoch % $full_day);
514 22 100 66     99 if (($day_start != $start_epoch) && ($start_epoch < $end_epoch)) {
515 17         81 $result += $self->_computed_trading_seconds($exchange, $start_epoch, min($day_start + 86399, $end_epoch));
516 17         32 $start_epoch = $day_start + $full_day;
517             }
518 22 100 100     93 if (($day_end != $end_epoch) && ($start_epoch < $end_epoch)) {
519 10         32 $result += $self->_computed_trading_seconds($exchange, max($start_epoch, $day_end), $end_epoch);
520 10         29 $end_epoch = $day_end;
521             }
522              
523             # step 2: calculate intermediated values (which are guaranteed to be day-boundary)
524             # with cache-aware way
525 22 100       45 if ($start_epoch < $end_epoch) {
526 7         21 $result += $self->_seconds_of_trading_between_epochs_days_boundary($exchange, $start_epoch, $end_epoch);
527             }
528              
529 22         500 return $result;
530             }
531              
532             =head2 regular_trading_day_after
533              
534             ->regular_trading_day_after($exchange_object, $date_object);
535              
536             Returns a Date::Utility object on a trading day where the exchange does not close early or open late after the given date.
537              
538             =cut
539              
540             sub regular_trading_day_after {
541 2     2 1 7149 my ($self, $exchange, $when) = @_;
542              
543 2 50       8 return undef if $self->closing_on($exchange, $when);
544              
545 2         20 my $counter = 0;
546 2         13 my $regular_trading_day = $self->trade_date_after($exchange, $when);
547 2         14 while ($counter <= 10) {
548 2         11 my $possible = $regular_trading_day->plus_time_interval($counter . 'd');
549 2 50 33     186 if ( not $self->closes_early_on($exchange, $possible)
      33        
550             and not $self->opens_late_on($exchange, $possible)
551             and $self->trades_on($exchange, $possible))
552             {
553 2         10 $regular_trading_day = $possible;
554 2         5 last;
555             }
556 0         0 $counter++;
557             }
558              
559 2         8 return $regular_trading_day;
560             }
561              
562             =head2 trading_period
563              
564             ->trading_period('HKSE', Date::Utility->new);
565              
566             Returns an array reference of hash references of open and close time of the given exchange and epoch
567              
568             =cut
569              
570             sub trading_period {
571 2     2 1 5375 my ($self, $exchange, $when) = @_;
572              
573 2 50       7 return [] if not $self->trades_on($exchange, $when);
574 2         8 my $open = $self->opening_on($exchange, $when);
575 2         8 my $close = $self->closing_on($exchange, $when);
576 2         10 my $breaks = $self->trading_breaks($exchange, $when);
577              
578 2         6 my @times = ($open);
579 2 100       8 if (defined $breaks) {
580 1         3 push @times, @{$_} for @{$breaks};
  1         3  
  1         5  
581             }
582 2         8 push @times, $close;
583              
584 2         6 my @periods;
585 2         7 for (my $i = 0; $i < $#times; $i += 2) {
586 3         90 push @periods,
587             {
588             open => $times[$i]->epoch,
589             close => $times[$i + 1]->epoch
590             };
591             }
592              
593 2         37 return \@periods;
594             }
595              
596             =head2 is_holiday_for
597              
598             Check if it is a holiday for a specific exchange or a country on a specific day
599              
600             ->is_holiday_for('ASX', '2013-01-01'); # Australian exchange holiday
601             ->is_holiday_for('USD', Date::Utility->new); # United States country holiday
602              
603             Returns the description of the holiday if it is a holiday.
604              
605             =cut
606              
607             sub is_holiday_for {
608 82     82 1 10582 my ($self, $symbol, $date) = @_;
609              
610 82         186 return $self->_get_holidays_for($symbol, $date);
611             }
612              
613             =head2 is_in_dst_at
614              
615             ->is_in_dst_at($exchange_object, $date_object);
616              
617             Is this exchange trading on daylight savings times for the given epoch?
618              
619             =cut
620              
621             sub is_in_dst_at {
622 163     163 1 21458 my ($self, $exchange, $epoch) = @_;
623              
624 163         458 return Date::Utility->new($epoch)->is_dst_in_zone($exchange->trading_timezone);
625             }
626              
627             ### PRIVATE ###
628              
629             sub _get_holidays_for {
630 82     82   149 my ($self, $symbol, $when) = @_;
631              
632 82         190 my $date = $when->truncate_to_day->epoch;
633 82         4607 my $calendar = $self->calendar->{holidays};
634 82         159 my $holiday = $calendar->{$date};
635              
636 82 100       346 return undef unless $holiday;
637              
638 24         85 foreach my $holiday_desc (keys %$holiday) {
639 24 100   31   99 return $holiday_desc if (first { $symbol eq $_ } @{$holiday->{$holiday_desc}});
  31         212  
  24         99  
640             }
641              
642 2         14 return undef;
643             }
644              
645             sub _is_in_trading_break {
646 16     16   34 my ($self, $exchange, $when) = @_;
647              
648 16         41 $when = Date::Utility->new($when);
649 16         142 my $in_trading_break = 0;
650 16 100       44 if (my $breaks = $self->trading_breaks($exchange, $when)) {
651 5         10 foreach my $break_interval (@{$breaks}) {
  5         12  
652 5 100 100     143 if ($when->epoch >= $break_interval->[0]->epoch and $when->epoch <= $break_interval->[1]->epoch) {
653 2         88 $in_trading_break++;
654 2         6 last;
655             }
656             }
657             }
658              
659 16         175 return $in_trading_break;
660             }
661              
662             =head2 get_exchange_open_times
663              
664             Query an exchange for valid opening times. Expects 3 parameters:
665              
666             =over 4
667              
668             =item * C<$exchange> - a L<Finance::Exchange> instance
669              
670             =item * C<$date> - a L<Date::Utility>
671              
672             =item * C<$which> - which market information to request, see below
673              
674             =back
675              
676             The possible values for C<$which> include:
677              
678             =over 4
679              
680             =item * C<daily_open>
681              
682             =item * C<daily_close>
683              
684             =item * C<trading_breaks>
685              
686             =back
687              
688             Returns either C<undef>, a single L<Date::Utility>, or an arrayref of L<Date::Utility> instances.
689              
690             =cut
691              
692             sub get_exchange_open_times {
693 143     143 1 277 my ($self, $exchange, $date, $which) = @_;
694              
695 143 50       324 my $when = (ref $date) ? $date : Date::Utility->new($date);
696 143         315 my $that_midnight = $self->trading_date_for($exchange, $when);
697 143         3525 my $requested_time;
698 143 100       331 if ($self->trades_on($exchange, $that_midnight)) {
699 126         281 my $dst_key = $self->_times_dst_key($exchange, $that_midnight);
700 126         14463 my $ti = $exchange->market_times->{$dst_key}->{$which};
701 126         1197 my $extended_lunch_hour;
702 126 100       278 if ($which eq 'trading_breaks') {
703 81         1963 my $extended_trading_breaks = $exchange->market_times->{$dst_key}->{day_of_week_extended_trading_breaks};
704 81 50 33     768 $extended_lunch_hour = ($extended_trading_breaks and $when->day_of_week == $extended_trading_breaks) ? 1 : 0;
705             }
706 126 100       253 if ($ti) {
707 106 100       249 if (ref $ti eq 'ARRAY') {
708 61 50       162 my $trading_breaks = $extended_lunch_hour ? @$ti[1] : @$ti[0];
709 61         183 my $start_of_break = $that_midnight->plus_time_interval($trading_breaks->[0]);
710 61         3519 my $end_of_break = $that_midnight->plus_time_interval($trading_breaks->[1]);
711 61         2922 push @{$requested_time}, [$start_of_break, $end_of_break];
  61         209  
712             } else {
713 45         128 $requested_time = $that_midnight->plus_time_interval($ti);
714             }
715             }
716             }
717 143         7533 return $requested_time; # returns null on no trading days.
718             }
719              
720             sub _times_dst_key {
721 161     161   589 my ($self, $exchange, $when) = @_;
722              
723 161 50       3624 my $epoch = (ref $when) ? $when->epoch : $when;
724              
725 161 100       1134 return 'dst' if $self->is_in_dst_at($exchange, $epoch);
726 115         14010 return 'standard';
727             }
728              
729             # get partial trading data for a given exchange
730             sub _get_partial_trading_for {
731 58     58   126 my ($self, $exchange, $type, $when) = @_;
732              
733 58         1488 my $cached = $self->calendar->{$type};
734 58         197 my $date = $when->truncate_to_day->epoch;
735 58         2342 my $partial_defined = $cached->{$date};
736              
737 58 100       189 return undef unless $partial_defined;
738              
739 5         13 foreach my $close_time (keys %{$cached->{$date}}) {
  5         56  
740 5         12 my $symbols = $cached->{$date}{$close_time};
741 5 50   5   48 return $close_time if (first { $exchange->symbol eq $_ } @$symbols);
  5         139  
742             }
743              
744 0         0 return undef;
745             }
746              
747             sub _days_between {
748             my ($self, $begin, $end) = @_;
749              
750             my @days_between = ();
751              
752             # Don't include start and end days.
753             my $current = Date::Utility->new($begin)->truncate_to_day->plus_time_interval('1d');
754             $end = Date::Utility->new($end)->truncate_to_day->minus_time_interval('1d');
755              
756             # Generate all days between.
757             while (not $current->is_after($end)) {
758             push @days_between, $current;
759             $current = $current->plus_time_interval('1d'); # Next day, please!
760             }
761              
762             return \@days_between;
763             }
764              
765             Memoize::memoize('_days_between', NORMALIZER => '_normalize_on_just_dates');
766              
767             =head2 next_open_at
768              
769             ->next_open_at($exchange_object, Date::Utility->new('2023-02-16 15:30:00'));
770              
771             Returns Date::Utility object of the next opening date and time.
772              
773             Returns undef if exchange is open for the requested date.
774              
775             =cut
776              
777             sub next_open_at {
778 7     7 1 15739 my ($self, $exchange, $date) = @_;
779              
780 7 50       23 return undef if $self->is_open_at($exchange, $date);
781              
782 7         31 my $market_opens = $self->_market_opens($exchange, $date);
783             # exchange is closed for the trading day
784 7 100       214 unless (defined $market_opens->{open}) {
785 4         14 my $next_trading = $self->trade_date_after($exchange, $date);
786 4         25 return $self->opening_on($exchange, $next_trading);
787             }
788              
789             # exchange is closed for trading breaks, will open again
790 3 50       9 unless ($market_opens->{open}) {
791 3         9 my $trading_breaks = $self->trading_breaks($exchange, $date);
792              
793 3         12 foreach my $break ($trading_breaks->@*) {
794 2         25 my ($close, $open) = $break->@*;
795              
796             # Between trading brakes
797 2 100 66     9 if ($date->is_after($close) and $date->is_before($open)) {
    50 33        
798 1         19 return $open;
799             } elsif ($date->is_before($close) and $date->is_after($date->truncate_to_day)) { # Between midnight and first opening
800 1         66 return $self->opening_on($exchange, $date);
801             }
802             }
803              
804             # When there is no trading break but opens on same day
805 1 50       5 if (!@$trading_breaks) {
806 1         5 my $opening_late = $self->opening_on($exchange, $date);
807 1         5 return $opening_late;
808             }
809             }
810              
811             # we shouldn't reach here but, return undef instead of a wrong time here.
812 0         0 return undef;
813             }
814              
815             ## PRIVATE _market_opens
816             #
817             # PARAMETERS :
818             # - time : the time as a timestamp
819             #
820             # RETURNS : A reference to a hash with the following keys:
821             # - open : is set to 1 if the market is currently open, 0 if market is closed
822             # but will open, 'undef' if market is closed and will not open again
823             # today.
824             # - closed : undefined if market has not been open yet, otherwise contains the
825             # seconds for how long the market was closed.
826             # - opens : undefined if market is currently open and does not open anymore today,
827             # otherwise the market will open in 'opens' seconds.
828             # - closes : undefined if open is undef, otherwise market will close in 'closes' seconds.
829             # - opened : undefined if market is closed, contains the seconds the market has
830             # been open.
831             #
832             #
833             ########
834             sub _market_opens {
835 17     17   33 my ($self, $exchange, $when) = @_;
836              
837 17         27 my $date = $when;
838             # Figure out which "trading day" we are on
839             # even if it differs from the GMT calendar day.
840 17         48 my $next_day = $date->plus_time_interval('1d')->truncate_to_day;
841 17         4035 my $next_open = $self->opening_on($exchange, $next_day);
842 17 50 66     91 $date = $next_day if ($next_open and not $date->is_before($next_open));
843              
844 17         97 my $open = $self->opening_on($exchange, $date);
845 17         45 my $close = $self->closing_on($exchange, $date);
846              
847 17 100       54 if (not $open) {
848              
849             # date is not a trading day: will not and has not been open today
850 2         7 my $next_open = $self->opening_on($exchange, $self->trade_date_after($exchange, $when));
851             return {
852 2         46 open => undef,
853             opens => $next_open->epoch - $when->epoch,
854             opened => undef,
855             closes => undef,
856             closed => undef,
857             };
858             }
859              
860 15         41 my $breaks = $self->trading_breaks($exchange, $when);
861             # not trading breaks
862 15 100       51 if (not $breaks) {
863             # Past closing time: opens next trading day, and has been open today
864 7 100 66     34 if ($close and not $when->is_before($close)) {
    50 0        
    0 0        
      0        
865             return {
866 4         139 open => undef,
867             opens => undef,
868             opened => $when->epoch - $open->epoch,
869             closes => undef,
870             closed => $when->epoch - $close->epoch,
871             };
872             } elsif ($when->is_before($open)) {
873             return {
874 3         123 open => 0,
875             opens => $open->epoch - $when->epoch,
876             opened => undef,
877             closes => $close->epoch - $when->epoch,
878             closed => undef,
879             };
880             } elsif ($when->is_same_as($open) or ($when->is_after($open) and $when->is_before($close)) or $when->is_same_same($close)) {
881             return {
882 0         0 open => 1,
883             opens => undef,
884             opened => $when->epoch - $open->epoch,
885             closes => $close->epoch - $when->epoch,
886             closed => undef,
887             };
888             }
889             } else {
890 8         24 my @breaks = @$breaks;
891             # Past closing time: opens next trading day, and has been open today
892 8 100 66     40 if ($close and not $when->is_before($close)) {
    100          
893             return {
894 3         112 open => undef,
895             opens => undef,
896             opened => $when->epoch - $breaks[-1][1]->epoch,
897             closes => undef,
898             closed => $when->epoch - $close->epoch,
899             };
900             } elsif ($when->is_before($open)) {
901             return {
902 1         56 open => 0,
903             opens => $open->epoch - $when->epoch,
904             opened => undef,
905             closes => $breaks[0][0]->epoch - $when->epoch,
906             closed => undef,
907             };
908             } else {
909 4         70 my $current_open = $open;
910 4         16 for (my $i = 0; $i <= $#breaks; $i++) {
911 4         11 my $int_open = $breaks[$i][0];
912 4         7 my $int_close = $breaks[$i][1];
913 4 50       12 my $next_open = exists $breaks[$i + 1] ? $breaks[$i + 1][0] : $close;
914              
915 4 100 33     10 if ($when->is_before($int_open)
    50 66        
    0 33        
      33        
      33        
      0        
916             and ($when->is_same_as($current_open) or $when->is_after($current_open)))
917             {
918             return {
919 1         47 open => 1,
920             opens => undef,
921             opened => $when->epoch - $current_open->epoch,
922             closes => $int_open->epoch - $when->epoch,
923             closed => undef,
924             };
925             } elsif ($when->is_same_as($int_open)
926             or ($when->is_after($int_open) and $when->is_before($int_close))
927             or $when->is_same_as($int_close))
928             {
929             return {
930 3         181 open => 0,
931             opens => $int_close->epoch - $when->epoch,
932             opened => undef,
933             closes => $close->epoch - $when->epoch, # we want to know seconds to official close
934             closed => $when->epoch - $int_open->epoch,
935             };
936             } elsif ($when->is_after($int_close) and $when->is_before($next_open)) {
937             return {
938 0         0 open => 1,
939             opens => undef,
940             opened => $when->epoch - $int_close->epoch,
941             closes => $next_open->epoch - $when->epoch,
942             closed => undef,
943             };
944             }
945             }
946              
947             }
948             }
949              
950 0         0 return undef;
951             }
952              
953             ## PRIVATE method _seconds_of_trading_between_epochs_days_boundary
954             #
955             # there is a strict assumption, that start and end epoch are day boundaries
956             #
957             my %cached_seconds_for_interval; # key ${epoch1}-${epoch2}, value: seconds
958              
959             sub _seconds_of_trading_between_epochs_days_boundary {
960 23     23   76 my ($self, $exchange, $start_epoch, $end_epoch) = @_;
961              
962 23         552 my $cache_key = join('-', $exchange->symbol, $start_epoch, $end_epoch);
963 23   66     266 my $result = $cached_seconds_for_interval{$cache_key} //= do {
964 22         68 my $head = $self->_computed_trading_seconds($exchange, $start_epoch, $start_epoch + 86399);
965 22 100       102 if ($end_epoch - $start_epoch > $full_day - 1) {
966 16         58 my $tail = $self->_seconds_of_trading_between_epochs_days_boundary($exchange, $start_epoch + $full_day, $end_epoch);
967 16         33 $head + $tail;
968             }
969             };
970              
971 23         57 return $result;
972             }
973              
974             ## PRIVATE method _computed_trading_seconds
975             #
976             # This one ACTUALLY does the heavy lifting of determining the number of trading seconds in an intraday period.
977             #
978             sub _computed_trading_seconds {
979 49     49   128 my ($self, $exchange, $start, $end) = @_;
980              
981 49         78 my $total_trading_time = 0;
982 49         130 my $when = Date::Utility->new($start);
983              
984 49 100       1740 if ($self->trades_on($exchange, $when)) {
985              
986             # Do the full computation.
987 42         104 my $opening_epoch = $self->opening_on($exchange, $when)->epoch;
988 42         302 my $closing_epoch = $self->closing_on($exchange, $when)->epoch;
989              
990             # Total trading time left in interval. This is always between 0 to $period_secs_basis.
991             # This will automatically take care of early close because market close will just be the early close time.
992 42         373 my $total_trading_time_including_lunchbreaks =
993             max(min($closing_epoch, $end), $opening_epoch) - min(max($opening_epoch, $start), $closing_epoch);
994              
995 42         59 my $total_lunch_break_time = 0;
996              
997             # Now take care of lunch breaks. But handle early close properly. It could be that
998             # the early close already wipes out the need to handle lunch breaks.
999             # Handle early close. For example on 24 Dec 2009, HKSE opens at 2:00, and stops
1000             # for lunch at 4:30 and never reopens. In that case the value of $self->closing_on($thisday)
1001             # is 4:30, and lunch time between 4:30 to 6:00 is no longer relevant.
1002 42 50       101 if (my $breaks = $self->trading_breaks($exchange, $when)) {
1003 42         66 for my $break_interval (@{$breaks}) {
  42         84  
1004 42         71 my $interval_open = $break_interval->[0];
1005 42         66 my $interval_close = $break_interval->[1];
1006 42         1065 my $close_am = min($interval_open->epoch, $closing_epoch);
1007 42         1108 my $open_pm = min($interval_close->epoch, $closing_epoch);
1008              
1009 42         307 $total_lunch_break_time = max(min($open_pm, $end), $close_am) - min(max($close_am, $start), $open_pm);
1010              
1011 42 50       117 if ($total_lunch_break_time < 0) {
1012 0         0 die 'Total lunch break time between ' . $start . '] and [' . $end . '] for exchange[' . $self->exchange->symbol . '] is negative';
1013             }
1014             }
1015             }
1016              
1017 42         66 $total_trading_time = $total_trading_time_including_lunchbreaks - $total_lunch_break_time;
1018 42 50       135 if ($total_trading_time < 0) {
1019 0         0 croak 'Total trading time (minus lunch) between '
1020             . $start
1021             . '] and ['
1022             . $end
1023             . '] for exchange['
1024             . $self->exchange->symbol
1025             . '] is negative.';
1026             }
1027             }
1028              
1029 49         100 return $total_trading_time;
1030             }
1031              
1032             ## PRIVATE static methods
1033             #
1034             # Many of these functions don't change their results if asked for the
1035             # same dates many times. Let's exploit that for time over space
1036             #
1037             # This actually comes up in our pricing where we have to do many interpolations
1038             # over the same ranges on different values.
1039             #
1040             # This attaches to the static method on the class for the lifetime of this instance.
1041             # Since we only want the cache for our specific symbol, we need to include an identifier.
1042              
1043             sub _normalize_on_just_dates {
1044 6     6   151 my ($self, @dates) = @_;
1045              
1046 6         14 return join '|', (map { Date::Utility->new($_)->days_since_epoch } @dates);
  12         486  
1047             }
1048              
1049 1     1   14 no Moose;
  1         4  
  1         13  
1050             __PACKAGE__->meta->make_immutable;
1051              
1052             1;