File Coverage

blib/lib/Finance/Calendar.pm
Criterion Covered Total %
statement 287 313 91.6
branch 101 138 73.1
condition 47 87 54.0
subroutine 42 43 97.6
pod 24 24 100.0
total 501 605 82.8


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   654785 use Moose;
  1         11  
  1         7  
61              
62             our $VERSION = '0.04';
63              
64 1     1   5906 use List::Util qw(min max first);
  1         2  
  1         77  
65 1     1   520 use Date::Utility;
  1         682680  
  1         40  
66 1     1   598 use Memoize;
  1         2048  
  1         45  
67 1     1   7 use Finance::Exchange;
  1         2  
  1         25  
68 1     1   6 use Carp qw(croak);
  1         1  
  1         3437  
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 447     447   788 my ($self, $method_name, $exchange, @dates) = @_;
93              
94 447 100       9734 return undef unless exists $self->_cache->{$method_name};
95              
96 439         8267 my $key = join "_", ($exchange->symbol, (map { $self->trading_date_for($exchange, $_)->epoch } @dates));
  443         3124  
97 439         26555 return $self->_cache->{$method_name}{$key};
98             }
99              
100             sub _set_cache {
101 177     177   364 my ($self, $value, $method_name, $exchange, @dates) = @_;
102              
103 177         3446 my $key = join "_", ($exchange->symbol, (map { $self->trading_date_for($exchange, $_)->epoch } @dates));
  183         1274  
104 177         9837 $self->_cache->{$method_name}{$key} = $value;
105              
106 177         291 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 267     267 1 3774 my ($self, $exchange, $when) = @_;
121              
122 267 100       462 if (my $cache = $self->_get_cache('trades_on', $exchange, $when)) {
123 171         432 return $cache;
124             }
125              
126 96         1176 my $really_when = $self->trading_date_for($exchange, $when);
127 96 100 100     3867 my $result = (@{$exchange->trading_days_list}[$really_when->day_of_week] && !$self->is_holiday_for($exchange->symbol, $really_when)) ? 1 : 0;
128              
129 96         582 $self->_set_cache($result, 'trades_on', $exchange, $when);
130 96         258 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 7577 my ($self, $exchange, $when) = @_;
143              
144 5         13 my $begin = $self->trading_date_for($exchange, $when);
145              
146 5 50       81 if (my $cache = $self->_get_cache('trade_date_before', $exchange, $begin)) {
147 0         0 return $cache;
148             }
149              
150 5         6 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     21 while (not $date_behind and $counter < 10) {
157 8         29 my $possible = $begin->minus_time_interval($counter . 'd');
158 8 100       554 $date_behind = $possible if $self->trades_on($exchange, $possible);
159 8         24 $counter++;
160             }
161              
162 5         12 $self->_set_cache($date_behind, 'trade_date_before', $exchange, $begin);
163 5         92 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 15     15 1 8602 my ($self, $exchange, $date) = @_;
176              
177 15         21 my $date_next;
178 15         25 my $counter = 1;
179 15         34 my $begin = $self->trading_date_for($exchange, $date);
180              
181 15 100       532 if (my $cache = $self->_get_cache('trade_date_after', $exchange, $begin)) {
182 2         7 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 13   66     56 while (not $date_next and $counter <= 11) {
188 22         74 my $possible = $begin->plus_time_interval($counter . 'd');
189 22 100       3144 $date_next = $possible if $self->trades_on($exchange, $possible);
190 22         72 $counter++;
191             }
192              
193 13         30 $self->_set_cache($date_next, 'trade_date_after', $exchange, $begin);
194 13         117 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 857     857 1 3632 my ($self, $exchange, $date) = @_;
210              
211             # if there's no pre-midnight open, then returns the same day.
212 857 100       17452 return $date->truncate_to_day unless ($exchange->trading_date_can_differ);
213              
214 35         957 my $next_day = $date->plus_time_interval('1d')->truncate_to_day;
215             my $open_ti =
216 35         4442 $exchange->market_times->{$self->_times_dst_key($exchange, $next_day)}->{daily_open};
217              
218 35 100 66     2366 return $next_day if ($open_ti and $next_day->epoch + $open_ti->seconds <= $date->epoch);
219 34         1299 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 4685 my ($self, $exchange, $when) = @_;
233              
234 6 50       16 if (my $cache = $self->_get_cache('calendar_days_to_trade_date_after', $exchange, $when)) {
235 0         0 return $cache;
236             }
237              
238 6         16 my $number_of_days = $self->trade_date_after($exchange, $when)->days_between($when);
239              
240 6         473 $self->_set_cache($number_of_days, 'calendar_days_to_trade_date_after', $exchange, $when);
241 6         24 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 5089 my ($self, $exchange, $begin, $end) = @_;
255              
256 4 50       10 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         7 my $number_of_days = scalar grep { $self->trades_on($exchange, $_) } @{$self->_days_between($begin, $end)};
  6         33  
  4         53  
262              
263 4         56 $self->_set_cache($number_of_days, 'trading_days_between', $exchange, $begin, $end);
264 4         17 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 4257 my ($self, $exchange, $begin, $end) = @_;
277              
278 2 50       6 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         258  
  2         27  
284              
285 2         8 $self->_set_cache($number_of_days, 'holiday_days_between', $exchange, $begin, $end);
286 2         7 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 10125 my ($self, $exchange) = @_;
301              
302 1         10 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 10     10 1 5833 my ($self, $exchange, $date) = @_;
315 10         35 my $opening = $self->opening_on($exchange, $date);
316 10 100 100     46 return undef if (not $opening or $self->_is_in_trading_break($exchange, $date));
317 8 100 100     25 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 5         56 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 231 my ($self, $exchange, $date) = @_;
332              
333 5         20 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 3452 my ($self, $exchange, $date) = @_;
346              
347 5         15 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 81     81 1 3277 my ($self, $exchange, $when) = @_;
360              
361 81 100       138 if (my $cache = $self->_get_cache('opening_on', $exchange, $when)) {
362 51         705 return $cache;
363             }
364              
365 30   100     81 my $opening_on = $self->opens_late_on($exchange, $when) // $self->get_exchange_open_times($exchange, $when, 'daily_open');
366              
367 30         75 $self->_set_cache($opening_on, 'opening_on', $exchange, $when);
368 30         190 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 67     67 1 3725 my ($self, $exchange, $when) = @_;
381              
382 67 100       129 if (my $cache = $self->_get_cache('closing_on', $exchange, $when)) {
383 46         673 return $cache;
384             }
385              
386 21   100     62 my $closing_on = $self->closes_early_on($exchange, $when) // $self->get_exchange_open_times($exchange, $when, 'daily_close');
387              
388 21         59 $self->_set_cache($closing_on, 'closing_on', $exchange, $when);
389 21         195 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 64     64 1 1921 my ($self, $exchange, $when) = @_;
402              
403 64         149 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 45     45 1 7091 my ($self, $exchange, $when) = @_;
426              
427             # Only applies on Fridays
428 45 100       872 return undef if $when->day_of_week != 5;
429              
430 15         258 my $changes;
431              
432 15         27 my $rule = 'Fridays';
433 15 100 100     294 if ($exchange->symbol eq 'FOREX' or $exchange->symbol eq 'METAL') {
434 4         82 $changes = {
435             'daily_close' => {
436             to => '20h55m',
437             rule => $rule,
438             }};
439             }
440              
441 15         335 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 27     27 1 5587 my ($self, $exchange, $when) = @_;
455              
456 27 100       71 return undef unless $self->trades_on($exchange, $when);
457              
458 23         35 my $closes_early;
459 23         60 my $listed = $self->_get_partial_trading_for($exchange, 'early_closes', $when);
460 23 100       108 if ($listed) {
    100          
461 3         8 $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       8 if ($scheduled_changes->{daily_close});
465             }
466              
467 23         976 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 34     34 1 1091 my ($self, $exchange, $when) = @_;
480              
481 34 100       68 return undef unless $self->trades_on($exchange, $when);
482              
483 23         34 my $opens_late;
484 23         69 my $listed = $self->_get_partial_trading_for($exchange, 'late_opens', $when);
485 23 100       90 if ($listed) {
    50          
486 2         8 $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 23         622 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 26520 my ($self, $exchange, $start, $end) = @_;
507              
508 22         559 my ($start_epoch, $end_epoch) = ($start->epoch, $end->epoch);
509 22         205 my $result = 0;
510              
511             # step 1: calculate non-cached incomplete start-day and end_dates
512 22         39 my $day_start = $start_epoch - ($start_epoch % $full_day);
513 22         30 my $day_end = $end_epoch - ($end_epoch % $full_day);
514 22 100 66     110 if (($day_start != $start_epoch) && ($start_epoch < $end_epoch)) {
515 17         60 $result += $self->_computed_trading_seconds($exchange, $start_epoch, min($day_start + 86399, $end_epoch));
516 17         29 $start_epoch = $day_start + $full_day;
517             }
518 22 100 100     82 if (($day_end != $end_epoch) && ($start_epoch < $end_epoch)) {
519 10         31 $result += $self->_computed_trading_seconds($exchange, max($start_epoch, $day_end), $end_epoch);
520 10         17 $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       40 if ($start_epoch < $end_epoch) {
526 7         23 $result += $self->_seconds_of_trading_between_epochs_days_boundary($exchange, $start_epoch, $end_epoch);
527             }
528              
529 22         404 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 6312 my ($self, $exchange, $when) = @_;
542              
543 2 50       6 return undef if $self->closing_on($exchange, $when);
544              
545 2         4 my $counter = 0;
546 2         7 my $regular_trading_day = $self->trade_date_after($exchange, $when);
547 2         6 while ($counter <= 10) {
548 2         8 my $possible = $regular_trading_day->plus_time_interval($counter . 'd');
549 2 50 33     156 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         4 $regular_trading_day = $possible;
554 2         3 last;
555             }
556 0         0 $counter++;
557             }
558              
559 2         5 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 6481 my ($self, $exchange, $when) = @_;
572              
573 2 50       8 return [] if not $self->trades_on($exchange, $when);
574 2         9 my $open = $self->opening_on($exchange, $when);
575 2         8 my $close = $self->closing_on($exchange, $when);
576 2         7 my $breaks = $self->trading_breaks($exchange, $when);
577              
578 2         5 my @times = ($open);
579 2 100       6 if (defined $breaks) {
580 1         2 push @times, @{$_} for @{$breaks};
  1         4  
  1         3  
581             }
582 2         4 push @times, $close;
583              
584 2         4 my @periods;
585 2         8 for (my $i = 0; $i < $#times; $i += 2) {
586 3         72 push @periods,
587             {
588             open => $times[$i]->epoch,
589             close => $times[$i + 1]->epoch
590             };
591             }
592              
593 2         28 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 74     74 1 9256 my ($self, $symbol, $date) = @_;
609              
610 74         172 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 134     134 1 18136 my ($self, $exchange, $epoch) = @_;
623              
624 134         327 return Date::Utility->new($epoch)->is_dst_in_zone($exchange->trading_timezone);
625             }
626              
627             ### PRIVATE ###
628              
629             sub _get_holidays_for {
630 74     74   131 my ($self, $symbol, $when) = @_;
631              
632 74         150 my $date = $when->truncate_to_day->epoch;
633 74         3426 my $calendar = $self->calendar->{holidays};
634 74         129 my $holiday = $calendar->{$date};
635              
636 74 100       256 return undef unless $holiday;
637              
638 24         80 foreach my $holiday_desc (keys %$holiday) {
639 24 100   31   95 return $holiday_desc if (first { $symbol eq $_ } @{$holiday->{$holiday_desc}});
  31         173  
  24         87  
640             }
641              
642 2         10 return undef;
643             }
644              
645             sub _is_in_trading_break {
646 9     9   20 my ($self, $exchange, $when) = @_;
647              
648 9         20 $when = Date::Utility->new($when);
649 9         66 my $in_trading_break = 0;
650 9 100       25 if (my $breaks = $self->trading_breaks($exchange, $when)) {
651 1         2 foreach my $break_interval (@{$breaks}) {
  1         2  
652 1 50 33     20 if ($when->epoch >= $break_interval->[0]->epoch and $when->epoch <= $break_interval->[1]->epoch) {
653 1         41 $in_trading_break++;
654 1         4 last;
655             }
656             }
657             }
658              
659 9         35 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 112     112 1 202 my ($self, $exchange, $date, $which) = @_;
694              
695 112 50       217 my $when = (ref $date) ? $date : Date::Utility->new($date);
696 112         168 my $that_midnight = $self->trading_date_for($exchange, $when);
697 112         2257 my $requested_time;
698 112 100       210 if ($self->trades_on($exchange, $that_midnight)) {
699 97         177 my $dst_key = $self->_times_dst_key($exchange, $that_midnight);
700 97         6996 my $ti = $exchange->market_times->{$dst_key}->{$which};
701 97         698 my $extended_lunch_hour;
702 97 100       189 if ($which eq 'trading_breaks') {
703 64         1200 my $extended_trading_breaks = $exchange->market_times->{$dst_key}->{day_of_week_extended_trading_breaks};
704 64 50 33     477 $extended_lunch_hour = ($extended_trading_breaks and $when->day_of_week == $extended_trading_breaks) ? 1 : 0;
705             }
706 97 100       165 if ($ti) {
707 84 100       189 if (ref $ti eq 'ARRAY') {
708 51 50       107 my $trading_breaks = $extended_lunch_hour ? @$ti[1] : @$ti[0];
709 51         116 my $start_of_break = $that_midnight->plus_time_interval($trading_breaks->[0]);
710 51         2357 my $end_of_break = $that_midnight->plus_time_interval($trading_breaks->[1]);
711 51         1945 push @{$requested_time}, [$start_of_break, $end_of_break];
  51         143  
712             } else {
713 33         84 $requested_time = $that_midnight->plus_time_interval($ti);
714             }
715             }
716             }
717 112         4515 return $requested_time; # returns null on no trading days.
718             }
719              
720             sub _times_dst_key {
721 132     132   425 my ($self, $exchange, $when) = @_;
722              
723 132 50       2490 my $epoch = (ref $when) ? $when->epoch : $when;
724              
725 132 100       721 return 'dst' if $self->is_in_dst_at($exchange, $epoch);
726 99         11369 return 'standard';
727             }
728              
729             # get partial trading data for a given exchange
730             sub _get_partial_trading_for {
731 46     46   100 my ($self, $exchange, $type, $when) = @_;
732              
733 46         953 my $cached = $self->calendar->{$type};
734 46         106 my $date = $when->truncate_to_day->epoch;
735 46         1405 my $partial_defined = $cached->{$date};
736              
737 46 100       104 return undef unless $partial_defined;
738              
739 5         10 foreach my $close_time (keys %{$cached->{$date}}) {
  5         18  
740 5         11 my $symbols = $cached->{$date}{$close_time};
741 5 50   5   34 return $close_time if (first { $exchange->symbol eq $_ } @$symbols);
  5         99  
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 0     0 1 0 my ($self, $exchange, $date) = @_;
779              
780 0 0       0 return undef if $self->is_open_at($exchange, $date);
781              
782 0         0 my $market_opens = $self->_market_opens($exchange, $date);
783             # exchange is closed for the trading day
784 0 0       0 unless (defined $market_opens->{open}) {
785 0         0 my $next_trading = $self->trade_date_after($exchange, $date);
786 0         0 return $self->opening_on($exchange, $next_trading);
787             }
788              
789             # exchange is closed for trading breaks, will open again
790 0 0       0 unless ($market_opens->{open}) {
791 0         0 my $trading_breaks = $self->trading_breaks($exchange, $date);
792 0         0 foreach my $break ($trading_breaks->@*) {
793 0         0 my ($close, $open) = $break->@*;
794 0 0 0     0 if ($date->is_after($close) and $date->is_before($open)) {
795 0         0 return $open;
796             }
797             }
798             }
799              
800             # we shouldn't reach here but, return undef instead of a wrong time here.
801 0         0 return undef;
802             }
803              
804             ## PRIVATE _market_opens
805             #
806             # PARAMETERS :
807             # - time : the time as a timestamp
808             #
809             # RETURNS : A reference to a hash with the following keys:
810             # - open : is set to 1 if the market is currently open, 0 if market is closed
811             # but will open, 'undef' if market is closed and will not open again
812             # today.
813             # - closed : undefined if market has not been open yet, otherwise contains the
814             # seconds for how long the market was closed.
815             # - opens : undefined if market is currently open and does not open anymore today,
816             # otherwise the market will open in 'opens' seconds.
817             # - closes : undefined if open is undef, otherwise market will close in 'closes' seconds.
818             # - opened : undefined if market is closed, contains the seconds the market has
819             # been open.
820             #
821             #
822             ########
823             sub _market_opens {
824 10     10   22 my ($self, $exchange, $when) = @_;
825              
826 10         14 my $date = $when;
827             # Figure out which "trading day" we are on
828             # even if it differs from the GMT calendar day.
829 10         31 my $next_day = $date->plus_time_interval('1d')->truncate_to_day;
830 10         1809 my $next_open = $self->opening_on($exchange, $next_day);
831 10 50 66     29 $date = $next_day if ($next_open and not $date->is_before($next_open));
832              
833 10         43 my $open = $self->opening_on($exchange, $date);
834 10         25 my $close = $self->closing_on($exchange, $date);
835              
836 10 100       25 if (not $open) {
837              
838             # date is not a trading day: will not and has not been open today
839 2         7 my $next_open = $self->opening_on($exchange, $self->trade_date_after($exchange, $when));
840             return {
841 2         38 open => undef,
842             opens => $next_open->epoch - $when->epoch,
843             opened => undef,
844             closes => undef,
845             closed => undef,
846             };
847             }
848              
849 8         19 my $breaks = $self->trading_breaks($exchange, $when);
850             # not trading breaks
851 8 100       19 if (not $breaks) {
852             # Past closing time: opens next trading day, and has been open today
853 4 100 66     17 if ($close and not $when->is_before($close)) {
    50 0        
    0 0        
      0        
854             return {
855 2         48 open => undef,
856             opens => undef,
857             opened => $when->epoch - $open->epoch,
858             closes => undef,
859             closed => $when->epoch - $close->epoch,
860             };
861             } elsif ($when->is_before($open)) {
862             return {
863 2         82 open => 0,
864             opens => $open->epoch - $when->epoch,
865             opened => undef,
866             closes => $close->epoch - $when->epoch,
867             closed => undef,
868             };
869             } elsif ($when->is_same_as($open) or ($when->is_after($open) and $when->is_before($close)) or $when->is_same_same($close)) {
870             return {
871 0         0 open => 1,
872             opens => undef,
873             opened => $when->epoch - $open->epoch,
874             closes => $close->epoch - $when->epoch,
875             closed => undef,
876             };
877             }
878             } else {
879 4         10 my @breaks = @$breaks;
880             # Past closing time: opens next trading day, and has been open today
881 4 100 66     16 if ($close and not $when->is_before($close)) {
    50          
882             return {
883 1         28 open => undef,
884             opens => undef,
885             opened => $when->epoch - $breaks[-1][1]->epoch,
886             closes => undef,
887             closed => $when->epoch - $close->epoch,
888             };
889             } elsif ($when->is_before($open)) {
890             return {
891 0         0 open => 0,
892             opens => $open->epoch - $when->epoch,
893             opened => undef,
894             closes => $breaks[0][0]->epoch - $when->epoch,
895             closed => undef,
896             };
897             } else {
898 3         44 my $current_open = $open;
899 3         10 for (my $i = 0; $i <= $#breaks; $i++) {
900 3         7 my $int_open = $breaks[$i][0];
901 3         5 my $int_close = $breaks[$i][1];
902 3 50       9 my $next_open = exists $breaks[$i + 1] ? $breaks[$i + 1][0] : $close;
903              
904 3 100 33     8 if ($when->is_before($int_open)
    50 66        
    0 33        
      33        
      33        
      0        
905             and ($when->is_same_as($current_open) or $when->is_after($current_open)))
906             {
907             return {
908 1         39 open => 1,
909             opens => undef,
910             opened => $when->epoch - $current_open->epoch,
911             closes => $int_open->epoch - $when->epoch,
912             closed => undef,
913             };
914             } elsif ($when->is_same_as($int_open)
915             or ($when->is_after($int_open) and $when->is_before($int_close))
916             or $when->is_same_as($int_close))
917             {
918             return {
919 2         96 open => 0,
920             opens => $int_close->epoch - $when->epoch,
921             opened => undef,
922             closes => $close->epoch - $when->epoch, # we want to know seconds to official close
923             closed => $when->epoch - $int_open->epoch,
924             };
925             } elsif ($when->is_after($int_close) and $when->is_before($next_open)) {
926             return {
927 0         0 open => 1,
928             opens => undef,
929             opened => $when->epoch - $int_close->epoch,
930             closes => $next_open->epoch - $when->epoch,
931             closed => undef,
932             };
933             }
934             }
935              
936             }
937             }
938              
939 0         0 return undef;
940             }
941              
942             ## PRIVATE method _seconds_of_trading_between_epochs_days_boundary
943             #
944             # there is a strict assumption, that start and end epoch are day boundaries
945             #
946             my %cached_seconds_for_interval; # key ${epoch1}-${epoch2}, value: seconds
947              
948             sub _seconds_of_trading_between_epochs_days_boundary {
949 23     23   42 my ($self, $exchange, $start_epoch, $end_epoch) = @_;
950              
951 23         445 my $cache_key = join('-', $exchange->symbol, $start_epoch, $end_epoch);
952 23   66     189 my $result = $cached_seconds_for_interval{$cache_key} //= do {
953 22         51 my $head = $self->_computed_trading_seconds($exchange, $start_epoch, $start_epoch + 86399);
954 22 100       77 if ($end_epoch - $start_epoch > $full_day - 1) {
955 16         53 my $tail = $self->_seconds_of_trading_between_epochs_days_boundary($exchange, $start_epoch + $full_day, $end_epoch);
956 16         27 $head + $tail;
957             }
958             };
959              
960 23         41 return $result;
961             }
962              
963             ## PRIVATE method _computed_trading_seconds
964             #
965             # This one ACTUALLY does the heavy lifting of determining the number of trading seconds in an intraday period.
966             #
967             sub _computed_trading_seconds {
968 49     49   74 my ($self, $exchange, $start, $end) = @_;
969              
970 49         59 my $total_trading_time = 0;
971 49         123 my $when = Date::Utility->new($start);
972              
973 49 100       1470 if ($self->trades_on($exchange, $when)) {
974              
975             # Do the full computation.
976 42         83 my $opening_epoch = $self->opening_on($exchange, $when)->epoch;
977 42         238 my $closing_epoch = $self->closing_on($exchange, $when)->epoch;
978              
979             # Total trading time left in interval. This is always between 0 to $period_secs_basis.
980             # This will automatically take care of early close because market close will just be the early close time.
981 42         296 my $total_trading_time_including_lunchbreaks =
982             max(min($closing_epoch, $end), $opening_epoch) - min(max($opening_epoch, $start), $closing_epoch);
983              
984 42         56 my $total_lunch_break_time = 0;
985              
986             # Now take care of lunch breaks. But handle early close properly. It could be that
987             # the early close already wipes out the need to handle lunch breaks.
988             # Handle early close. For example on 24 Dec 2009, HKSE opens at 2:00, and stops
989             # for lunch at 4:30 and never reopens. In that case the value of $self->closing_on($thisday)
990             # is 4:30, and lunch time between 4:30 to 6:00 is no longer relevant.
991 42 50       89 if (my $breaks = $self->trading_breaks($exchange, $when)) {
992 42         55 for my $break_interval (@{$breaks}) {
  42         65  
993 42         54 my $interval_open = $break_interval->[0];
994 42         46 my $interval_close = $break_interval->[1];
995 42         817 my $close_am = min($interval_open->epoch, $closing_epoch);
996 42         923 my $open_pm = min($interval_close->epoch, $closing_epoch);
997              
998 42         280 $total_lunch_break_time = max(min($open_pm, $end), $close_am) - min(max($close_am, $start), $open_pm);
999              
1000 42 50       97 if ($total_lunch_break_time < 0) {
1001 0         0 die 'Total lunch break time between ' . $start . '] and [' . $end . '] for exchange[' . $self->exchange->symbol . '] is negative';
1002             }
1003             }
1004             }
1005              
1006 42         59 $total_trading_time = $total_trading_time_including_lunchbreaks - $total_lunch_break_time;
1007 42 50       89 if ($total_trading_time < 0) {
1008 0         0 croak 'Total trading time (minus lunch) between '
1009             . $start
1010             . '] and ['
1011             . $end
1012             . '] for exchange['
1013             . $self->exchange->symbol
1014             . '] is negative.';
1015             }
1016             }
1017              
1018 49         75 return $total_trading_time;
1019             }
1020              
1021             ## PRIVATE static methods
1022             #
1023             # Many of these functions don't change their results if asked for the
1024             # same dates many times. Let's exploit that for time over space
1025             #
1026             # This actually comes up in our pricing where we have to do many interpolations
1027             # over the same ranges on different values.
1028             #
1029             # This attaches to the static method on the class for the lifetime of this instance.
1030             # Since we only want the cache for our specific symbol, we need to include an identifier.
1031              
1032             sub _normalize_on_just_dates {
1033 6     6   117 my ($self, @dates) = @_;
1034              
1035 6         11 return join '|', (map { Date::Utility->new($_)->days_since_epoch } @dates);
  12         416  
1036             }
1037              
1038 1     1   9 no Moose;
  1         2  
  1         7  
1039             __PACKAGE__->meta->make_immutable;
1040              
1041             1;