1package A::ResultSet::DateMethods1;
2
3use Test::Roo;
4use Test::Deep 'cmp_deeply', 'bag';
5use DateTime;
6use Test::Fatal;
7
8with 'A::Role::TestConnect';
9
10use lib 't/lib';
11
12sub _dt {
13   DateTime->new(
14      time_zone => 'UTC',
15      year => shift(@_), month => shift(@_), day => shift(@_),
16   )
17}
18
19has [qw(
20   add_sql_by_part_skip add_sql_by_part_result
21   subtract_sql_by_part_skip subtract_sql_by_part_result
22   pluck_sql_by_part_skip pluck_sql_by_part_result
23)] => (
24   is => 'ro',
25   default => sub { {} },
26);
27
28has [map "${_}_sql_by_part", qw(pluck add subtract)] => (
29   is => 'ro',
30   default => sub { {} },
31);
32
33has _skip_msg_once => ( is => 'rw' );
34sub skip_reason {
35   return '(see above)' if $_[0]->_skip_msg_once;
36   $_[0]->_skip_msg_once(1);
37   'set ' . join(q<, >, shift->env_vars) . ' to run these tests'
38}
39
40has [qw(
41   utc_now stringified_date add_sql_prefix subtract_sql_prefix sub_sql pluck_sql_prefix
42)] => (is => 'ro');
43
44has plucked_minute => (
45   is => 'ro',
46   default => 9,
47);
48
49has plucked_second => (
50   is => 'ro',
51   default => 8,
52);
53
54sub _merged_pluck_sql_by_part_result {
55   my $self = shift;
56
57   my %base = (
58      year         => 2012,
59      month        => 1,
60      day_of_month => 2,
61      hour         => 3,
62      day_of_year  => 2,
63      minute       => 4,
64      second       => 5,
65      day_of_week  => 1,
66      week         => 1,
67      quarter      => 1,
68   );
69
70   my %results = %{$self->pluck_sql_by_part_result};
71
72   my @overrides = grep { $base{$_} } sort keys %results;
73   note join(q(, ), @overrides) . ' overridden' if @overrides;
74
75   return +{ %base, %results };
76}
77
78sub _merged_add_sql_by_part_result {
79   my $self = shift;
80
81   return +{
82      day    => '2012-12-13 00:00:00',
83      hour   => '2012-12-12 02:00:00',
84      minute => '2012-12-12 00:03:00',
85      month  => '2013-04-12 00:00:00',
86      second => '2012-12-12 00:00:05',
87      year   => '2018-12-12 00:00:00',
88      %{$self->add_sql_by_part_result},
89   }
90}
91
92sub _merged_subtract_sql_by_part_result {
93   my $self = shift;
94
95   return +{
96      day    => '2012-12-11 00:00:00',
97      hour   => '2012-12-11 22:00:00',
98      minute => '2012-12-11 23:57:00',
99      month  => '2012-08-12 00:00:00',
100      second => '2012-12-11 23:59:55',
101      year   => '2006-12-12 00:00:00',
102      %{$self->subtract_sql_by_part_result},
103   }
104}
105
106sub rs { shift->schema->resultset('HasDateOps') }
107
108sub pop_rs_1 {
109   my $self = shift;
110
111   $self->rs->delete;
112   $self->rs->populate([
113      [qw(id a_date)],
114      [1, $self->format_datetime(_dt(2012, 12, 12)), ],
115      [2, $self->format_datetime(_dt(2012, 12, 13)), ],
116      [3, $self->format_datetime(_dt(2012, 12, 14)), ],
117   ])
118}
119
120sub pop_rs_2 {
121   my $self = shift;
122
123   my $dt1 = $self->format_datetime(_dt(2012, 12, 12));
124   my $dt2 = $self->format_datetime(_dt(2012, 12, 13));
125   $self->rs->delete;
126   $self->rs->populate([
127      [qw(id a_date b_date)],
128      [1, $dt1, $dt2],
129      [2, $dt1, $dt1],
130      [3, $dt2, $dt1],
131   ])
132}
133
134sub format_datetime {
135   shift->schema
136      ->storage
137      ->datetime_parser
138      ->format_datetime(shift @_)
139}
140
141sub parse_datetime {
142   shift->schema
143      ->storage
144      ->datetime_parser
145      ->parse_datetime(shift @_)
146}
147
148test basic => sub {
149   my $self = shift;
150
151   is(${$self->rs->utc_now}, $self->utc_now, 'utc_now');
152
153   like(exception {
154      $self->rs->utc(DateTime->new(year => 1985, month => 1, day => 1))
155   }, qr/floating dates are not allowed/, 'no floating dates');
156
157   SKIP: {
158      skip $self->skip_reason, 1 unless $self->connected;
159
160      my $central_date = DateTime->new(
161         year   => 2014,
162         month  => 2,
163         day    => 7,
164         hour   => 22,
165         minute => 43,
166         time_zone => 'America/Chicago',
167      );
168
169      is(
170         $self->rs->utc($central_date),
171         $self->stringified_date,
172         'datetime correctly UTC and stringified'
173      );
174
175      my $local_dt = DateTime->now( time_zone => 'UTC' );
176
177      $self->rs->delete;
178      $self->rs->create({ id => 1, a_date => $self->rs->utc_now });
179
180      my $remote_dt = $self->parse_datetime($self->rs->next->a_date);
181
182      ok(
183         $local_dt->subtract_datetime_absolute($remote_dt)->seconds < 60,
184         'UTC works! (and clock is correct)',
185      );
186   }
187};
188
189sub _comparisons {
190   my ($self, $l, $r, $n) = @_;
191   subtest $n => sub {
192      cmp_deeply(
193         [$self->rs->dt_before($l => $r)->get_column('id')->all],
194         [1],
195         'before',
196      );
197
198      cmp_deeply(
199         [$self->rs->dt_on_or_before($l, $r)->get_column('id')->all],
200         bag(1, 2),
201         'on_or_before',
202      );
203
204      cmp_deeply(
205         [$self->rs->dt_on_or_after($l, $r)->get_column('id')->all],
206         bag(2, 3),
207         'on_or_after',
208      );
209
210      cmp_deeply(
211         [$self->rs->dt_after($l, $r)->get_column('id')->all],
212         [3],
213         'after',
214      );
215   };
216}
217
218sub _middle_comparisons {
219   my ($self, $r) = @_;
220
221   $self->_comparisons({ -ident => 'a_date' } => $r, 'no prefix');
222
223   $self->_comparisons({ -ident => '.a_date' } => $r, 'auto prefix');
224
225   $self->_comparisons(
226      { -ident => $self->rs->current_source_alias . '.a_date' }
227         => $r, 'manual prefix'
228   )
229}
230
231test comparisons => sub {
232   my $self = shift;
233
234   SKIP: {
235      skip $self->skip_reason, 1 unless $self->connected;
236
237      $self->pop_rs_1;
238
239      my $dt = _dt(2012, 12, 13);
240      subtest 'datetime object' =>
241         sub { $self->_middle_comparisons($dt) };
242
243      subtest 'datetime literal'=> sub {
244         $self->_middle_comparisons($self->format_datetime($dt))
245      };
246
247      subtest subquery => sub {
248         $self->_middle_comparisons(
249            $self->rs->search({ id => 2})->get_column('a_date')->as_query
250         )
251      };
252
253      subtest 'both columns' => sub {
254         $self->pop_rs_2;
255
256         $self->_middle_comparisons({ -ident => '.b_date' }, 'auto prefix');
257         $self->_middle_comparisons({ -ident => 'b_date' }, 'no prefix');
258         $self->_middle_comparisons(
259            { -ident => $self->rs->current_source_alias . '.b_date' },
260            'manual prefix',
261         );
262      };
263
264      subtest 'literal SQL' => sub {
265         cmp_deeply(
266            [$self->rs->dt_before(
267               { -ident => '.b_date' },
268               $self->rs->utc_now
269            )->get_column('id')->all],
270            [1, 2, 3],
271            'literal SQL compared (and db clock correct)',
272         );
273      };
274   }
275};
276
277test add => sub {
278   my $self = shift;
279
280   $self->pop_rs_1 if $self->connected;
281
282   SKIP: {
283      skip $self->engine  . q(doesn't set add_sql_prefix) unless $self->add_sql_prefix;
284
285      my %offset = (
286         day => 1,
287         hour => 2,
288         minute => 3,
289         month => 4,
290         second => 5,
291         year => 6,
292      );
293      my $i = 1 + scalar keys %offset;
294      for my $part (sort keys %{$self->add_sql_by_part}) {
295         my $query = $self->rs->dt_SQL_add(
296            { -ident => 'a_date' },
297            $part,
298            $offset{$part} || $i++,
299         );
300         SKIP: {
301            skip $self->skip_reason, 1 unless $self->connected;
302            skip $self->add_sql_by_part_skip->{$part}, 1
303               if $self->add_sql_by_part_skip->{$part};
304
305            my $v;
306            my $e = exception {
307               $v = $self->rs->search({ id => 1 }, {
308                  columns => { v => $query },
309               })->get_column('v')->next;
310            };
311            ok !$e, "live $part" or diag "exception: $e";
312            my $expected = $self->_merged_add_sql_by_part_result->{$part};
313
314            if (ref $expected && ref $expected eq 'Regexp') {
315               like($v, $expected, "suspected $part");
316            } else {
317               is($v, $expected, "suspected $part");
318            }
319         }
320
321         cmp_deeply(
322            $query,
323            $self->add_sql_by_part->{$part},
324            "unit: $part",
325         );
326      }
327
328      cmp_deeply(
329         $self->rs->dt_SQL_add({ -ident => '.a_date' }, 'second', 1),
330         $self->add_sql_prefix,
331         'vanilla add',
332      );
333   }
334
335   SKIP: {
336      skip $self->skip_reason, 1 unless $self->connected;
337
338      my $dt = DateTime->new(
339         time_zone => 'UTC',
340         year => 2013,
341         month => 12,
342         day => 11,
343         hour => 10,
344         minute => 9,
345         second => 8,
346      );
347
348      $self->rs->delete;
349      $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) });
350
351      subtest column => sub {
352         my $added = $self->rs->search(undef, {
353            rows => 1,
354            columns => { foo =>
355               $self->rs->dt_SQL_add(
356                  $self->rs->dt_SQL_add(
357                     $self->rs->dt_SQL_add({ -ident => '.a_date' }, 'minute', 2),
358                        second => 4,
359                  ), hour => 1,
360               ),
361            },
362            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
363         })->first->{foo};
364         $added = $self->parse_datetime($added);
365
366         is($added->year => 2013, 'added year');
367         is($added->month => 12, 'added month');
368         is($added->day => 11, 'added day');
369         is($added->hour => 11, 'added hour');
370         is($added->minute => 11, 'added minute');
371         is($added->second => 12, 'added second');
372      };
373
374      subtest bindarg => sub {
375         my $added = $self->rs->search(undef, {
376            rows => 1,
377            columns => { foo =>
378               $self->rs->dt_SQL_add(
379                  $self->rs->dt_SQL_add(
380                     $self->rs->dt_SQL_add($dt, 'minute', 2),
381                        second => 4,
382                  ), hour => 1,
383               ),
384            },
385            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
386         })->first->{foo};
387         $added = $self->parse_datetime($added);
388
389         is($added->year => 2013, 'added year');
390         is($added->month => 12, 'added month');
391         is($added->day => 11, 'added day');
392         is($added->hour => 11, 'added hour');
393         is($added->minute => 11, 'added minute');
394         is($added->second => 12, 'added second');
395      };
396   }
397};
398
399test subtract => sub {
400   my $self = shift;
401
402   $self->pop_rs_1 if $self->connected;
403
404   SKIP: {
405      skip $self->engine  . q(doesn't set subtract_sql_prefix) unless $self->subtract_sql_prefix;
406
407      my %offset = (
408         day => 1,
409         hour => 2,
410         minute => 3,
411         month => 4,
412         second => 5,
413         year => 6,
414      );
415      my $i = 1 + scalar keys %offset;
416      for my $part (sort keys %{$self->subtract_sql_by_part}) {
417         my $query = $self->rs->dt_SQL_subtract(
418            { -ident => 'a_date' },
419            $part,
420            $offset{$part} || $i++,
421         );
422
423         SKIP: {
424            skip $self->skip_reason, 1 unless $self->connected;
425            skip $self->subtract_sql_by_part_skip->{$part}, 1
426               if $self->subtract_sql_by_part_skip->{$part};
427
428            my $v;
429            my $e = exception {
430               $v = $self->rs->search({ id => 1 }, {
431                  columns => { v => $query },
432               })->get_column('v')->next;
433            };
434            ok !$e, "live $part" or diag "exception: $e";
435            my $expected = $self->_merged_subtract_sql_by_part_result->{$part};
436
437            if (ref $expected && ref $expected eq 'Regexp') {
438               like($v, $expected, "suspected $part");
439            } else {
440               is($v, $expected, "suspected $part");
441            }
442         }
443
444         cmp_deeply(
445            $query,
446            $self->subtract_sql_by_part->{$part},
447            "unit: $part",
448         );
449      }
450
451      cmp_deeply(
452         $self->rs->dt_SQL_subtract({ -ident => '.a_date' }, 'second', 1),
453         $self->subtract_sql_prefix,
454         'vanilla subtract',
455      );
456   }
457
458   SKIP: {
459      skip $self->skip_reason, 1 unless $self->connected;
460
461      my $dt = DateTime->new(
462         time_zone => 'UTC',
463         year => 2013,
464         month => 12,
465         day => 11,
466         hour => 10,
467         minute => 9,
468         second => 8,
469      );
470
471      $self->rs->delete;
472      $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) });
473
474      subtest column => sub {
475         my $subtracted = $self->rs->search(undef, {
476            rows => 1,
477            columns => { foo =>
478               $self->rs->dt_SQL_subtract(
479                  $self->rs->dt_SQL_subtract(
480                     $self->rs->dt_SQL_subtract({ -ident => '.a_date' }, 'minute', 2),
481                        second => 4,
482                  ), hour => 1,
483               ),
484            },
485            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
486         })->first->{foo};
487         $subtracted = $self->parse_datetime($subtracted);
488
489         is($subtracted->year => 2013, 'subtracted year');
490         is($subtracted->month => 12, 'subtracted month');
491         is($subtracted->day => 11, 'subtracted day');
492         is($subtracted->hour => 9, 'subtracted hour');
493         is($subtracted->minute => 7, 'subtracted minute');
494         is($subtracted->second => 4, 'subtracted second');
495      };
496
497      subtest bindarg => sub {
498         my $subtracted = $self->rs->search(undef, {
499            rows => 1,
500            columns => { foo =>
501               $self->rs->dt_SQL_subtract(
502                  $self->rs->dt_SQL_subtract(
503                     $self->rs->dt_SQL_subtract($dt, 'minute', 2),
504                        second => 4,
505                  ), hour => 1,
506               ),
507            },
508            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
509         })->first->{foo};
510         $subtracted = $self->parse_datetime($subtracted);
511
512         is($subtracted->year => 2013, 'subtracted year');
513         is($subtracted->month => 12, 'subtracted month');
514         is($subtracted->day => 11, 'subtracted day');
515         is($subtracted->hour => 9, 'subtracted hour');
516         is($subtracted->minute => 7, 'subtracted minute');
517         is($subtracted->second => 4, 'subtracted second');
518      };
519   }
520};
521
522test pluck => sub {
523   my $self = shift;
524
525   if ($self->connected) {
526      $self->rs->delete;
527      $self->rs->populate([
528         [qw(id a_date)],
529         [1, $self->format_datetime(
530               DateTime->new(
531                  year => 2012,
532                  month => 1,
533                  day => 2,
534                  hour => 3,
535                  minute => 4,
536                  second => 5,
537               )
538            )
539         ],
540      ])
541   }
542
543   my $i = 1;
544   for my $part (sort keys %{$self->pluck_sql_by_part}) {
545         SKIP: {
546            skip $self->skip_reason, 1 unless $self->connected;
547            skip $self->pluck_sql_by_part_skip->{$part}, 1
548               if $self->pluck_sql_by_part_skip->{$part};
549
550            my $res;
551            my $e = exception {
552               $res = $self->rs->search({ id => 1 }, {
553                  columns => {
554                     a_date => 'a_date',
555                     v => $self->rs->dt_SQL_pluck({ -ident => 'a_date' }, $part)
556                  },
557                  result_class => 'DBIx::Class::ResultClass::HashRefInflator',
558               })->next;
559            };
560            my $v = $res->{v};
561            my $date = $res->{a_date};
562            ok !$e, "live $part" or diag "exception: $e";
563            is(
564               $v,
565               $self->_merged_pluck_sql_by_part_result->{$part},
566               "suspected $part"
567            ) or diag "for date $date";
568         }
569
570      cmp_deeply(
571         $self->rs->dt_SQL_pluck({ -ident => 'a_date' }, $part),
572         $self->pluck_sql_by_part->{$part},
573         "unit $part",
574      );
575   }
576
577   cmp_deeply(
578      $self->rs->dt_SQL_pluck({ -ident => '.a_date' }, 'second'),
579      $self->pluck_sql_prefix,
580      'vanilla pluck',
581   );
582
583   SKIP: {
584      skip $self->skip_reason, 1 unless $self->connected;
585
586      my $dt = DateTime->new(
587         time_zone => 'UTC',
588         year => 2013,
589         month => 12,
590         day => 11,
591         hour => 10,
592         minute => 9,
593         second => 8,
594      );
595
596      $self->rs->delete;
597      $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) });
598
599      my @parts = qw(year month day_of_month hour minute second);
600      {
601         my $plucked = $self->rs->search(undef, {
602            rows => 1,
603            select => [map $self->rs->dt_SQL_pluck({ -ident => '.a_date' }, $_), @parts],
604            as => \@parts,
605            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
606         })->first;
607
608         cmp_deeply($plucked, {
609            year => 2013,
610            month => 12,
611            day_of_month => 11,
612            hour => 10,
613            minute => $self->plucked_minute,
614            second => $self->plucked_second,
615         }, 'live pluck works from column');
616      }
617      {
618         my $plucked = $self->rs->search(undef, {
619            rows => 1,
620            select => [map $self->rs->dt_SQL_pluck($dt, $_), @parts],
621            as => \@parts,
622            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
623         })->first;
624
625         cmp_deeply($plucked, {
626            year => 2013,
627            month => 12,
628            day_of_month => 11,
629            hour => 10,
630            minute => $self->plucked_minute,
631            second => $self->plucked_second,
632         }, 'live pluck works from bindarg');
633   }
634   }
635};
636
6371;
638