1# Copyright (C) 2003-2005 Joshua Hoblitt 2# 3# $Id: ISO8601.pm,v 1.25 2010/01/18 06:36:21 jhoblitt Exp $ 4 5package DateTime::Format::ISO8601; 6 7use strict; 8use warnings; 9 10use vars qw( $VERSION ); 11$VERSION = '0.07'; 12 13use Carp qw( croak ); 14use DateTime; 15use DateTime::Format::Builder; 16use Params::Validate qw( validate validate_pos BOOLEAN OBJECT SCALAR ); 17 18{ 19 my $default_legacy_year; 20 sub DefaultLegacyYear { 21 my $class = shift; 22 23 ( $default_legacy_year ) = validate_pos( @_, 24 { 25 type => BOOLEAN, 26 callbacks => { 27 'is 0, 1, or undef' => 28 sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, 29 }, 30 } 31 ) if @_; 32 33 return $default_legacy_year; 34 } 35} 36__PACKAGE__->DefaultLegacyYear( 1 ); 37 38{ 39 my $default_cut_off_year; 40 sub DefaultCutOffYear { 41 my $class = shift; 42 43 ( $default_cut_off_year ) = validate_pos( @_, 44 { 45 type => SCALAR, 46 callbacks => { 47 'is between 0 and 99' => 48 sub { $_[0] >= 0 && $_[0] <= 99 }, 49 }, 50 } 51 ) if @_; 52 53 return $default_cut_off_year; 54 } 55} 56# the same default value as DT::F::Mail 57__PACKAGE__->DefaultCutOffYear( 49 ); 58 59sub new { 60 my( $class ) = shift; 61 62 my %args = validate( @_, 63 { 64 base_datetime => { 65 type => OBJECT, 66 can => 'utc_rd_values', 67 optional => 1, 68 }, 69 legacy_year => { 70 type => BOOLEAN, 71 default => $class->DefaultLegacyYear, 72 callbacks => { 73 'is 0, 1, or undef' => 74 sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, 75 }, 76 }, 77 cut_off_year => { 78 type => SCALAR, 79 default => $class->DefaultCutOffYear, 80 callbacks => { 81 'is between 0 and 99' => 82 sub { $_[0] >= 0 && $_[0] <= 99 }, 83 }, 84 }, 85 } 86 ); 87 88 $class = ref( $class ) || $class; 89 90 my $self = bless( \%args, $class ); 91 92 if ( $args{ base_datetime } ) { 93 $self->set_base_datetime( object => $args{ base_datetime } ); 94 } 95 96 return( $self ); 97} 98 99# lifted from DateTime 100sub clone { bless { %{ $_[0] } }, ref $_[0] } 101 102sub base_datetime { $_[0]->{ base_datetime } } 103 104sub set_base_datetime { 105 my $self = shift; 106 107 my %args = validate( @_, 108 { 109 object => { 110 type => OBJECT, 111 can => 'utc_rd_values', 112 }, 113 } 114 ); 115 116 # ISO8601 only allows years 0 to 9999 117 # this implimentation ignores the needs of expanded formats 118 my $dt = DateTime->from_object( object => $args{ object } ); 119 my $lower_bound = DateTime->new( year => 0 ); 120 my $upper_bound = DateTime->new( year => 10000 ); 121 122 if ( $dt < $lower_bound ) { 123 croak "base_datetime must be greater then or equal to ", 124 $lower_bound->iso8601; 125 } 126 if ( $dt >= $upper_bound ) { 127 croak "base_datetime must be less then ", $upper_bound->iso8601; 128 } 129 130 $self->{ base_datetime } = $dt; 131 132 return $self; 133} 134 135sub legacy_year { $_[0]->{ legacy_year } } 136 137sub set_legacy_year { 138 my $self = shift; 139 140 my @args = validate_pos( @_, 141 { 142 type => BOOLEAN, 143 callbacks => { 144 'is 0, 1, or undef' => 145 sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, 146 }, 147 } 148 ); 149 150 $self->{ legacy_year } = $args[0]; 151 152 return $self; 153} 154 155sub cut_off_year { $_[0]->{ cut_off_year } } 156 157sub set_cut_off_year { 158 my $self = shift; 159 160 my @args = validate_pos( @_, 161 { 162 type => SCALAR, 163 callbacks => { 164 'is between 0 and 99' => 165 sub { $_[0] >= 0 && $_[0] <= 99 }, 166 }, 167 } 168 ); 169 170 $self->{ cut_off_year } = $args[0]; 171 172 return $self; 173} 174 175DateTime::Format::Builder->create_class( 176 parsers => { 177 parse_datetime => [ 178 { 179 #YYYYMMDD 19850412 180 length => 8, 181 regex => qr/^ (\d{4}) (\d\d) (\d\d) $/x, 182 params => [ qw( year month day ) ], 183 }, 184 { 185 # uncombined with above because 186 #regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) $/x, 187 # was matching 152746-05 188 189 #YYYY-MM-DD 1985-04-12 190 length => 10, 191 regex => qr/^ (\d{4}) - (\d\d) - (\d\d) $/x, 192 params => [ qw( year month day ) ], 193 }, 194 { 195 #YYYY-MM 1985-04 196 length => 7, 197 regex => qr/^ (\d{4}) - (\d\d) $/x, 198 params => [ qw( year month ) ], 199 }, 200 { 201 #YYYY 1985 202 length => 4, 203 regex => qr/^ (\d{4}) $/x, 204 params => [ qw( year ) ], 205 }, 206 { 207 #YY 19 (century) 208 length => 2, 209 regex => qr/^ (\d\d) $/x, 210 params => [ qw( year ) ], 211 postprocess => \&_normalize_century, 212 }, 213 { 214 #YYMMDD 850412 215 #YY-MM-DD 85-04-12 216 length => [ qw( 6 8 ) ], 217 regex => qr/^ (\d\d) -?? (\d\d) -?? (\d\d) $/x, 218 params => [ qw( year month day ) ], 219 postprocess => \&_fix_2_digit_year, 220 }, 221 { 222 #-YYMM -8504 223 #-YY-MM -85-04 224 length => [ qw( 5 6 ) ], 225 regex => qr/^ - (\d\d) -?? (\d\d) $/x, 226 params => [ qw( year month ) ], 227 postprocess => \&_fix_2_digit_year, 228 }, 229 { 230 #-YY -85 231 length => 3, 232 regex => qr/^ - (\d\d) $/x, 233 params => [ qw( year ) ], 234 postprocess => \&_fix_2_digit_year, 235 }, 236 { 237 #--MMDD --0412 238 #--MM-DD --04-12 239 length => [ qw( 6 7 ) ], 240 regex => qr/^ -- (\d\d) -?? (\d\d) $/x, 241 params => [ qw( month day ) ], 242 postprocess => \&_add_year, 243 }, 244 { 245 #--MM --04 246 length => 4, 247 regex => qr/^ -- (\d\d) $/x, 248 params => [ qw( month ) ], 249 postprocess => \&_add_year, 250 }, 251 { 252 #---DD ---12 253 length => 5, 254 regex => qr/^ --- (\d\d) $/x, 255 params => [ qw( day ) ], 256 postprocess => [ \&_add_year, \&_add_month ], 257 }, 258 { 259 #+[YY]YYYYMMDD +0019850412 260 #+[YY]YYYY-MM-DD +001985-04-12 261 length => [ qw( 11 13 ) ], 262 regex => qr/^ \+ (\d{6}) -?? (\d\d) -?? (\d\d) $/x, 263 params => [ qw( year month day ) ], 264 }, 265 { 266 #+[YY]YYYY-MM +001985-04 267 length => 10, 268 regex => qr/^ \+ (\d{6}) - (\d\d) $/x, 269 params => [ qw( year month ) ], 270 }, 271 { 272 #+[YY]YYYY +001985 273 length => 7, 274 regex => qr/^ \+ (\d{6}) $/x, 275 params => [ qw( year ) ], 276 }, 277 { 278 #+[YY]YY +0019 (century) 279 length => 5, 280 regex => qr/^ \+ (\d{4}) $/x, 281 params => [ qw( year ) ], 282 postprocess => \&_normalize_century, 283 }, 284 { 285 #YYYYDDD 1985102 286 #YYYY-DDD 1985-102 287 length => [ qw( 7 8 ) ], 288 regex => qr/^ (\d{4}) -?? (\d{3}) $/x, 289 params => [ qw( year day_of_year ) ], 290 constructor => [ 'DateTime', 'from_day_of_year' ], 291 }, 292 { 293 #YYDDD 85102 294 #YY-DDD 85-102 295 length => [ qw( 5 6 ) ], 296 regex => qr/^ (\d\d) -?? (\d{3}) $/x, 297 params => [ qw( year day_of_year ) ], 298 postprocess => [ \&_fix_2_digit_year ], 299 constructor => [ 'DateTime', 'from_day_of_year' ], 300 }, 301 { 302 #-DDD -102 303 length => 4, 304 regex => qr/^ - (\d{3}) $/x, 305 params => [ qw( day_of_year ) ], 306 postprocess => [ \&_add_year ], 307 constructor => [ 'DateTime', 'from_day_of_year' ], 308 }, 309 { 310 #+[YY]YYYYDDD +001985102 311 #+[YY]YYYY-DDD +001985-102 312 length => [ qw( 10 11 ) ], 313 regex => qr/^ \+ (\d{6}) -?? (\d{3}) $/x, 314 params => [ qw( year day_of_year ) ], 315 constructor => [ 'DateTime', 'from_day_of_year' ], 316 }, 317 { 318 #YYYYWwwD 1985W155 319 #YYYY-Www-D 1985-W15-5 320 length => [ qw( 8 10 ) ], 321 regex => qr/^ (\d{4}) -?? W (\d\d) -?? (\d) $/x, 322 params => [ qw( year week day_of_year ) ], 323 postprocess => [ \&_normalize_week ], 324 constructor => [ 'DateTime', 'from_day_of_year' ], 325 }, 326 { 327 #YYYYWww 1985W15 328 #YYYY-Www 1985-W15 329 length => [ qw( 7 8 ) ], 330 regex => qr/^ (\d{4}) -?? W (\d\d) $/x, 331 params => [ qw( year week ) ], 332 postprocess => [ \&_normalize_week ], 333 constructor => [ 'DateTime', 'from_day_of_year' ], 334 }, 335 { 336 #YYWwwD 85W155 337 #YY-Www-D 85-W15-5 338 length => [ qw( 6 8 ) ], 339 regex => qr/^ (\d\d) -?? W (\d\d) -?? (\d) $/x, 340 params => [ qw( year week day_of_year ) ], 341 postprocess => [ \&_fix_2_digit_year, \&_normalize_week ], 342 constructor => [ 'DateTime', 'from_day_of_year' ], 343 }, 344 { 345 #YYWww 85W15 346 #YY-Www 85-W15 347 length => [ qw( 5 6 ) ], 348 regex => qr/^ (\d\d) -?? W (\d\d) $/x, 349 params => [ qw( year week ) ], 350 postprocess => [ \&_fix_2_digit_year, \&_normalize_week ], 351 constructor => [ 'DateTime', 'from_day_of_year' ], 352 }, 353 { 354 #-YWwwD -5W155 355 #-Y-Www-D -5-W15-5 356 length => [ qw( 6 8 ) ], 357 regex => qr/^ - (\d) -?? W (\d\d) -?? (\d) $/x, 358 params => [ qw( year week day_of_year ) ], 359 postprocess => [ \&_fix_1_digit_year, \&_normalize_week ], 360 constructor => [ 'DateTime', 'from_day_of_year' ], 361 }, 362 { 363 #-YWww -5W15 364 #-Y-Www -5-W15 365 length => [ qw( 5 6 ) ], 366 regex => qr/^ - (\d) -?? W (\d\d) $/x, 367 params => [ qw( year week ) ], 368 postprocess => [ \&_fix_1_digit_year, \&_normalize_week ], 369 constructor => [ 'DateTime', 'from_day_of_year' ], 370 }, 371 { 372 #-WwwD -W155 373 #-Www-D -W15-5 374 length => [ qw( 5 6 ) ], 375 regex => qr/^ - W (\d\d) -?? (\d) $/x, 376 params => [ qw( week day_of_year ) ], 377 postprocess => [ \&_add_year, \&_normalize_week ], 378 constructor => [ 'DateTime', 'from_day_of_year' ], 379 }, 380 { 381 #-Www -W15 382 length => 4, 383 regex => qr/^ - W (\d\d) $/x, 384 params => [ qw( week ) ], 385 postprocess => [ \&_add_year, \&_normalize_week ], 386 constructor => [ 'DateTime', 'from_day_of_year' ], 387 }, 388 { 389 #-W-D -W-5 390 length => 4, 391 regex => qr/^ - W - (\d) $/x, 392 params => [ qw( day_of_year ) ], 393 postprocess => [ 394 \&_add_year, 395 \&_add_week, 396 \&_normalize_week, 397 ], 398 constructor => [ 'DateTime', 'from_day_of_year' ], 399 }, 400 { 401 #+[YY]YYYYWwwD +001985W155 402 #+[YY]YYYY-Www-D +001985-W15-5 403 length => [ qw( 11 13 ) ], 404 regex => qr/^ \+ (\d{6}) -?? W (\d\d) -?? (\d) $/x, 405 params => [ qw( year week day_of_year ) ], 406 postprocess => [ \&_normalize_week ], 407 constructor => [ 'DateTime', 'from_day_of_year' ], 408 }, 409 { 410 #+[YY]YYYYWww +001985W15 411 #+[YY]YYYY-Www +001985-W15 412 length => [ qw( 10 11 ) ], 413 regex => qr/^ \+ (\d{6}) -?? W (\d\d) $/x, 414 params => [ qw( year week ) ], 415 postprocess => [ \&_normalize_week ], 416 constructor => [ 'DateTime', 'from_day_of_year' ], 417 }, 418 { 419 #hhmmss 232050 - skipped 420 #hh:mm:ss 23:20:50 421 length => [ qw( 8 9 ) ], 422 regex => qr/^ T?? (\d\d) : (\d\d) : (\d\d) $/x, 423 params => [ qw( hour minute second) ], 424 postprocess => [ 425 \&_add_year, 426 \&_add_month, 427 \&_add_day 428 ], 429 }, 430 #hhmm 2320 - skipped 431 #hh 23 -skipped 432 { 433 #hh:mm 23:20 434 length => [ qw( 4 5 6 ) ], 435 regex => qr/^ T?? (\d\d) :?? (\d\d) $/x, 436 params => [ qw( hour minute ) ], 437 postprocess => [ 438 \&_add_year, 439 \&_add_month, 440 \&_add_day 441 ], 442 }, 443 { 444 #hhmmss,ss 232050,5 445 #hh:mm:ss,ss 23:20:50,5 446 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, 447 params => [ qw( hour minute second nanosecond) ], 448 postprocess => [ 449 \&_add_year, 450 \&_add_month, 451 \&_add_day, 452 \&_fractional_second 453 ], 454 }, 455 { 456 #hhmm,mm 2320,8 457 #hh:mm,mm 23:20,8 458 regex => qr/^ T?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, 459 params => [ qw( hour minute second ) ], 460 postprocess => [ 461 \&_add_year, 462 \&_add_month, 463 \&_add_day, 464 \&_fractional_minute 465 ], 466 }, 467 { 468 #hh,hh 23,3 469 regex => qr/^ T?? (\d\d) [\.,] (\d+) $/x, 470 params => [ qw( hour minute ) ], 471 postprocess => [ 472 \&_add_year, 473 \&_add_month, 474 \&_add_day, 475 \&_fractional_hour 476 ], 477 }, 478 { 479 #-mmss -2050 - skipped 480 #-mm:ss -20:50 481 length => 6, 482 regex => qr/^ - (\d\d) : (\d\d) $/x, 483 params => [ qw( minute second ) ], 484 postprocess => [ 485 \&_add_year, 486 \&_add_month, 487 \&_add_day, 488 \&_add_hour 489 ], 490 }, 491 #-mm -20 - skipped 492 #--ss --50 - skipped 493 { 494 #-mmss,s -2050,5 495 #-mm:ss,s -20:50,5 496 regex => qr/^ - (\d\d) :?? (\d\d) [\.,] (\d+) $/x, 497 params => [ qw( minute second nanosecond ) ], 498 postprocess => [ 499 \&_add_year, 500 \&_add_month, 501 \&_add_day, 502 \&_add_hour, 503 \&_fractional_second 504 ], 505 }, 506 { 507 #-mm,m -20,8 508 regex => qr/^ - (\d\d) [\.,] (\d+) $/x, 509 params => [ qw( minute second ) ], 510 postprocess => [ 511 \&_add_year, 512 \&_add_month, 513 \&_add_day, 514 \&_add_hour, 515 \&_fractional_minute 516 ], 517 }, 518 { 519 #--ss,s --50,5 520 regex => qr/^ -- (\d\d) [\.,] (\d+) $/x, 521 params => [ qw( second nanosecond) ], 522 postprocess => [ 523 \&_add_year, 524 \&_add_month, 525 \&_add_day, 526 \&_add_hour, 527 \&_add_minute, 528 \&_fractional_second, 529 ], 530 }, 531 { 532 #hhmmssZ 232030Z 533 #hh:mm:ssZ 23:20:30Z 534 length => [ qw( 7 8 9 10 ) ], 535 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) Z $/x, 536 params => [ qw( hour minute second ) ], 537 extra => { time_zone => 'UTC' }, 538 postprocess => [ 539 \&_add_year, 540 \&_add_month, 541 \&_add_day, 542 ], 543 }, 544 545 { 546 #hhmmss.ssZ 232030.5Z 547 #hh:mm:ss.ssZ 23:20:30.5Z 548 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) Z $/x, 549 params => [ qw( hour minute second nanosecond) ], 550 extra => { time_zone => 'UTC' }, 551 postprocess => [ 552 \&_add_year, 553 \&_add_month, 554 \&_add_day, 555 \&_fractional_second 556 ], 557 }, 558 559 { 560 #hhmmZ 2320Z 561 #hh:mmZ 23:20Z 562 length => [ qw( 5 6 7 ) ], 563 regex => qr/^ T?? (\d\d) :?? (\d\d) Z $/x, 564 params => [ qw( hour minute ) ], 565 extra => { time_zone => 'UTC' }, 566 postprocess => [ 567 \&_add_year, 568 \&_add_month, 569 \&_add_day, 570 ], 571 }, 572 { 573 #hhZ 23Z 574 length => [ qw( 3 4 ) ], 575 regex => qr/^ T?? (\d\d) Z $/x, 576 params => [ qw( hour ) ], 577 extra => { time_zone => 'UTC' }, 578 postprocess => [ 579 \&_add_year, 580 \&_add_month, 581 \&_add_day, 582 ], 583 }, 584 { 585 #hhmmss[+-]hhmm 152746+0100 152746-0500 586 #hh:mm:ss[+-]hh:mm 15:27:46+01:00 15:27:46-05:00 587 length => [ qw( 11 12 14 15 ) ], 588 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) 589 ([+-] \d\d :?? \d\d) $/x, 590 params => [ qw( hour minute second time_zone ) ], 591 postprocess => [ 592 \&_add_year, 593 \&_add_month, 594 \&_add_day, 595 \&_normalize_offset, 596 ], 597 }, 598 { 599 #hhmmss.ss[+-]hhmm 152746.5+0100 152746.5-0500 600 #hh:mm:ss.ss[+-]hh:mm 15:27:46.5+01:00 15:27:46.5-05:00 601 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) 602 ([+-] \d\d :?? \d\d) $/x, 603 params => [ qw( hour minute second nanosecond time_zone ) ], 604 postprocess => [ 605 \&_add_year, 606 \&_add_month, 607 \&_add_day, 608 \&_fractional_second, 609 \&_normalize_offset, 610 ], 611 }, 612 613 { 614 #hhmmss[+-]hh 152746+01 152746-05 615 #hh:mm:ss[+-]hh 15:27:46+01 15:27:46-05 616 length => [ qw( 9 10 11 12 ) ], 617 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) 618 ([+-] \d\d) $/x, 619 params => [ qw( hour minute second time_zone ) ], 620 postprocess => [ 621 \&_add_year, 622 \&_add_month, 623 \&_add_day, 624 \&_normalize_offset, 625 ], 626 }, 627 { 628 #YYYYMMDDThhmmss 19850412T101530 629 #YYYY-MM-DDThh:mm:ss 1985-04-12T10:15:30 630 length => [ qw( 15 19 ) ], 631 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 632 T (\d\d) :?? (\d\d) :?? (\d\d) $/x, 633 params => [ qw( year month day hour minute second ) ], 634 extra => { time_zone => 'floating' }, 635 }, 636 { 637 #YYYYMMDDThhmmss.ss 19850412T101530.123 638 #YYYY-MM-DDThh:mm:ss.ss 1985-04-12T10:15:30.123 639 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 640 T (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, 641 params => [ qw( year month day hour minute second nanosecond ) ], 642 extra => { time_zone => 'floating' }, 643 postprocess => [ 644 \&_fractional_second, 645 ], 646 }, 647 { 648 #YYYYMMDDThhmmssZ 19850412T101530Z 649 #YYYY-MM-DDThh:mm:ssZ 1985-04-12T10:15:30Z 650 length => [ qw( 16 20 ) ], 651 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 652 T (\d\d) :?? (\d\d) :?? (\d\d) Z $/x, 653 params => [ qw( year month day hour minute second ) ], 654 extra => { time_zone => 'UTC' }, 655 }, 656 { 657 #YYYYMMDDThhmmss.ssZ 19850412T101530.5Z 20041020T101530.5Z 658 #YYYY-MM-DDThh:mm:ss.ssZ 1985-04-12T10:15:30.5Z 1985-04-12T10:15:30.5Z 659 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 660 T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) 661 Z$/x, 662 params => [ qw( year month day hour minute second nanosecond ) ], 663 extra => { time_zone => 'UTC' }, 664 postprocess => [ 665 \&_fractional_second, 666 ], 667 }, 668 669 { 670 #YYYYMMDDThhmmss[+-]hhmm 19850412T101530+0400 671 #YYYY-MM-DDThh:mm:ss[+-]hh:mm 1985-04-12T10:15:30+04:00 672 length => [ qw( 20 25 ) ], 673 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 674 T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d :?? \d\d) $/x, 675 params => [ qw( year month day hour minute second time_zone ) ], 676 postprocess => \&_normalize_offset, 677 }, 678 { 679 #YYYYMMDDThhmmss.ss[+-]hhmm 19850412T101530.5+0100 20041020T101530.5-0500 680 #YYYY-MM-DDThh:mm:ss.ss[+-]hh:mm 1985-04-12T10:15:30.5+01:00 1985-04-12T10:15:30.5-05:00 681 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 682 T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) 683 ([+-] \d\d :?? \d\d) $/x, 684 params => [ qw( year month day hour minute second nanosecond time_zone ) ], 685 postprocess => [ 686 \&_fractional_second, 687 \&_normalize_offset, 688 ], 689 }, 690 691 { 692 #YYYYMMDDThhmmss[+-]hh 19850412T101530+04 693 #YYYY-MM-DDThh:mm:ss[+-]hh 1985-04-12T10:15:30+04 694 length => [ qw( 18 22 ) ], 695 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 696 T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d) $/x, 697 params => [ qw( year month day hour minute second time_zone ) ], 698 postprocess => \&_normalize_offset, 699 }, 700 { 701 #YYYYMMDDThhmm 19850412T1015 702 #YYYY-MM-DDThh:mm 1985-04-12T10:15 703 length => [ qw( 13 16 ) ], 704 regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) 705 T (\d\d) :?? (\d\d) $/x, 706 params => [ qw( year month day hour minute ) ], 707 extra => { time_zone => 'floating' }, 708 }, 709 { 710 #YYYYDDDThhmmZ 1985102T1015Z 711 #YYYY-DDDThh:mmZ 1985-102T10:15Z 712 length => [ qw( 13 15 ) ], 713 regex => qr/^ (\d{4}) -?? (\d{3}) T 714 (\d\d) :?? (\d\d) Z $/x, 715 params => [ qw( year day_of_year hour minute ) ], 716 extra => { time_zone => 'UTC' }, 717 constructor => [ 'DateTime', 'from_day_of_year' ], 718 719 }, 720 { 721 #YYYYWwwDThhmm[+-]hhmm 1985W155T1015+0400 722 #YYYY-Www-DThh:mm[+-]hh 1985-W15-5T10:15+04 723 length => [ qw( 18 19 ) ], 724 regex => qr/^ (\d{4}) -?? W (\d\d) -?? (\d) 725 T (\d\d) :?? (\d\d) ([+-] \d{2,4}) $/x, 726 params => [ qw( year week day_of_year hour minute time_zone) ], 727 postprocess => [ \&_normalize_week, \&_normalize_offset ], 728 constructor => [ 'DateTime', 'from_day_of_year' ], 729 }, 730 ], 731 parse_time => [ 732 { 733 #hhmmss 232050 734 length => [ qw( 6 7 ) ], 735 regex => qr/^ T?? (\d\d) (\d\d) (\d\d) $/x, 736 params => [ qw( hour minute second ) ], 737 postprocess => [ 738 \&_add_year, 739 \&_add_month, 740 \&_add_day, 741 ], 742 }, 743 { 744 #hhmm 2320 745 length => [ qw( 4 5 ) ], 746 regex => qr/^ T?? (\d\d) (\d\d) $/x, 747 params => [ qw( hour minute ) ], 748 postprocess => [ 749 \&_add_year, 750 \&_add_month, 751 \&_add_day, 752 ], 753 }, 754 { 755 #hh 23 756 length => [ qw( 2 3 ) ], 757 regex => qr/^ T?? (\d\d) $/x, 758 params => [ qw( hour ) ], 759 postprocess => [ 760 \&_add_year, 761 \&_add_month, 762 \&_add_day, 763 ], 764 }, 765 { 766 #-mmss -2050 767 length => 5, 768 regex => qr/^ - (\d\d) (\d\d) $/x, 769 params => [ qw( minute second ) ], 770 postprocess => [ 771 \&_add_year, 772 \&_add_month, 773 \&_add_day, 774 \&_add_hour, 775 ], 776 }, 777 { 778 #-mm -20 779 length => 3, 780 regex => qr/^ - (\d\d) $/x, 781 params => [ qw( minute ) ], 782 postprocess => [ 783 \&_add_year, 784 \&_add_month, 785 \&_add_day, 786 \&_add_hour, 787 ], 788 }, 789 { 790 #--ss --50 791 length => 4, 792 regex => qr/^ -- (\d\d) $/x, 793 params => [ qw( second ) ], 794 postprocess => [ 795 \&_add_year, 796 \&_add_month, 797 \&_add_day, 798 \&_add_hour, 799 \&_add_minute, 800 ], 801 }, 802 ], 803 } 804); 805 806sub _fix_1_digit_year { 807 my %p = @_; 808 809 no strict 'refs'; 810 my $year = ( $p{ self }{ base_datetime } || DateTime->now )->year; 811 use strict; 812 813 $year =~ s/.$//; 814 $p{ parsed }{ year } = $year . $p{ parsed }{ year }; 815 816 return 1; 817} 818 819sub _fix_2_digit_year { 820 my %p = @_; 821 822 # this is a mess because of the need to support parse_* being called 823 # as a class method 824 no strict 'refs'; 825 if ( exists $p{ self }{ legacy_year } ) { 826 if ( $p{ self }{ legacy_year } ) { 827 my $cutoff = exists $p{ self }{ cut_off_year } 828 ? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear; 829 $p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000; 830 } else { 831 my $century = ( $p{ self }{ base_datetime } || DateTime->now )->strftime( '%C' ); 832 $p{ parsed }{ year } += $century * 100; 833 } 834 } else { 835 my $cutoff = exists $p{ self }{ cut_off_year } 836 ? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear; 837 $p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000; 838 } 839 use strict; 840 841 return 1; 842} 843 844sub _add_minute { 845 my %p = @_; 846 847 no strict 'refs'; 848 $p{ parsed }{ minute } = ( $p{ self }{ base_datetime } || DateTime->now )->minute; 849 use strict; 850 851 return 1; 852} 853 854sub _add_hour { 855 my %p = @_; 856 857 no strict 'refs'; 858 $p{ parsed }{ hour } = ( $p{ self }{ base_datetime } || DateTime->now )->hour; 859 use strict; 860 861 return 1; 862} 863 864sub _add_day { 865 my %p = @_; 866 867 no strict 'refs'; 868 $p{ parsed }{ day } = ( $p{ self }{ base_datetime } || DateTime->now )->day; 869 use strict; 870 871 return 1; 872} 873 874sub _add_week { 875 my %p = @_; 876 877 no strict 'refs'; 878 $p{ parsed }{ week } = ( $p{ self }{ base_datetime } || DateTime->now )->week; 879 use strict; 880 881 return 1; 882} 883 884sub _add_month { 885 my %p = @_; 886 887 no strict 'refs'; 888 $p{ parsed }{ month } = ( $p{ self }{ base_datetime } || DateTime->now )->month; 889 use strict; 890 891 return 1; 892} 893 894sub _add_year { 895 my %p = @_; 896 897 no strict 'refs'; 898 $p{ parsed }{ year } = ( $p{ self }{ base_datetime } || DateTime->now )->year; 899 use strict; 900 901 return 1; 902} 903 904sub _fractional_second { 905 my %p = @_; 906 907 $p{ parsed }{ nanosecond } = ".$p{ parsed }{ nanosecond }" * 10**9; 908 909 return 1; 910} 911 912sub _fractional_minute { 913 my %p = @_; 914 915 $p{ parsed }{ second } = ".$p{ parsed }{ second }" * 60; 916 917 return 1; 918} 919 920sub _fractional_hour { 921 my %p = @_; 922 923 $p{ parsed }{ minute } = ".$p{ parsed }{ minute }" * 60; 924 925 return 1; 926} 927 928sub _normalize_offset { 929 my %p = @_; 930 931 $p{ parsed }{ time_zone } =~ s/://; 932 933 if( length $p{ parsed }{ time_zone } == 3 ) { 934 $p{ parsed }{ time_zone } .= '00'; 935 } 936 937 return 1; 938} 939 940sub _normalize_week { 941 my %p = @_; 942 943 # from section 4.3.2.2 944 # "A calendar week is identified within a calendar year by the calendar 945 # week number. This is its ordinal position within the year, applying the 946 # rule that the first calendar week of a year is the one that includes the 947 # first Thursday of that year and that the last calendar week of a 948 # calendar year is the week immediately preceding the first calendar week 949 # of the next calendar year." 950 951 # this make it oh so fun to covert an ISO week number to a count of days 952 953 my $dt = DateTime->new( 954 year => $p{ parsed }{ year }, 955 ); 956 957 if ( $dt->week_number == 1 ) { 958 $p{ parsed }{ week } -= 1; 959 } 960 961 $p{ parsed }{ week } *= 7; 962 963 if( defined $p{ parsed }{ day_of_year } ) { 964 $p{ parsed }{ week } -= $dt->day_of_week -1; 965 } 966 967 $p{ parsed }{ day_of_year } += $p{ parsed }{ week }; 968 969 delete $p{ parsed }{ week }; 970 971 return 1; 972} 973 974sub _normalize_century { 975 my %p = @_; 976 977 $p{ parsed }{ year } .= '01'; 978 979 return 1; 980} 981 9821; 983 984__END__ 985