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