1package DateTime::Format::Strptime; 2{ 3 $DateTime::Format::Strptime::VERSION = '1.54'; 4} 5 6use strict; 7 8use DateTime 1.00; 9use DateTime::Locale 0.45; 10use DateTime::TimeZone 0.79; 11use Params::Validate 0.64 qw( validate SCALAR SCALARREF BOOLEAN OBJECT CODEREF ); 12use Carp; 13 14use Exporter; 15use vars qw( @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg); 16 17@ISA = 'Exporter'; 18@EXPORT_OK = qw( &strftime &strptime ); 19@EXPORT = (); 20 21%ZONEMAP = ( 22 'A' => '+0100', 'ACDT' => '+1030', 'ACST' => '+0930', 23 'ADT' => 'Ambiguous', 'AEDT' => '+1100', 'AES' => '+1000', 24 'AEST' => '+1000', 'AFT' => '+0430', 'AHDT' => '-0900', 25 'AHST' => '-1000', 'AKDT' => '-0800', 'AKST' => '-0900', 26 'AMST' => '+0400', 'AMT' => '+0400', 'ANAST' => '+1300', 27 'ANAT' => '+1200', 'ART' => '-0300', 'AST' => 'Ambiguous', 28 'AT' => '-0100', 'AWST' => '+0800', 'AZOST' => '+0000', 29 'AZOT' => '-0100', 'AZST' => '+0500', 'AZT' => '+0400', 30 'B' => '+0200', 'BADT' => '+0400', 'BAT' => '+0600', 31 'BDST' => '+0200', 'BDT' => '+0600', 'BET' => '-1100', 32 'BNT' => '+0800', 'BORT' => '+0800', 'BOT' => '-0400', 33 'BRA' => '-0300', 'BST' => 'Ambiguous', 'BT' => 'Ambiguous', 34 'BTT' => '+0600', 'C' => '+0300', 'CAST' => '+0930', 35 'CAT' => 'Ambiguous', 'CCT' => 'Ambiguous', 'CDT' => 'Ambiguous', 36 'CEST' => '+0200', 'CET' => '+0100', 'CETDST' => '+0200', 37 'CHADT' => '+1345', 'CHAST' => '+1245', 'CKT' => '-1000', 38 'CLST' => '-0300', 'CLT' => '-0400', 'COT' => '-0500', 39 'CST' => 'Ambiguous', 'CSuT' => '+1030', 'CUT' => '+0000', 40 'CVT' => '-0100', 'CXT' => '+0700', 'ChST' => '+1000', 41 'D' => '+0400', 'DAVT' => '+0700', 'DDUT' => '+1000', 42 'DNT' => '+0100', 'DST' => '+0200', 'E' => '+0500', 43 'EASST' => '-0500', 'EAST' => 'Ambiguous', 'EAT' => '+0300', 44 'ECT' => 'Ambiguous', 'EDT' => 'Ambiguous', 'EEST' => '+0300', 45 'EET' => '+0200', 'EETDST' => '+0300', 'EGST' => '+0000', 46 'EGT' => '-0100', 'EMT' => '+0100', 'EST' => 'Ambiguous', 47 'ESuT' => '+1100', 'F' => '+0600', 'FDT' => 'Ambiguous', 48 'FJST' => '+1300', 'FJT' => '+1200', 'FKST' => '-0300', 49 'FKT' => '-0400', 'FST' => 'Ambiguous', 'FWT' => '+0100', 50 'G' => '+0700', 'GALT' => '-0600', 'GAMT' => '-0900', 51 'GEST' => '+0500', 'GET' => '+0400', 'GFT' => '-0300', 52 'GILT' => '+1200', 'GMT' => '+0000', 'GST' => 'Ambiguous', 53 'GT' => '+0000', 'GYT' => '-0400', 'GZ' => '+0000', 54 'H' => '+0800', 'HAA' => '-0300', 'HAC' => '-0500', 55 'HAE' => '-0400', 'HAP' => '-0700', 'HAR' => '-0600', 56 'HAT' => '-0230', 'HAY' => '-0800', 'HDT' => '-0930', 57 'HFE' => '+0200', 'HFH' => '+0100', 'HG' => '+0000', 58 'HKT' => '+0800', 'HL' => 'local', 'HNA' => '-0400', 59 'HNC' => '-0600', 'HNE' => '-0500', 'HNP' => '-0800', 60 'HNR' => '-0700', 'HNT' => '-0330', 'HNY' => '-0900', 61 'HOE' => '+0100', 'HST' => '-1000', 'I' => '+0900', 62 'ICT' => '+0700', 'IDLE' => '+1200', 'IDLW' => '-1200', 63 'IDT' => 'Ambiguous', 'IOT' => '+0500', 'IRDT' => '+0430', 64 'IRKST' => '+0900', 'IRKT' => '+0800', 'IRST' => '+0430', 65 'IRT' => '+0330', 'IST' => 'Ambiguous', 'IT' => '+0330', 66 'ITA' => '+0100', 'JAVT' => '+0700', 'JAYT' => '+0900', 67 'JST' => '+0900', 'JT' => '+0700', 'K' => '+1000', 68 'KDT' => '+1000', 'KGST' => '+0600', 'KGT' => '+0500', 69 'KOST' => '+1200', 'KRAST' => '+0800', 'KRAT' => '+0700', 70 'KST' => '+0900', 'L' => '+1100', 'LHDT' => '+1100', 71 'LHST' => '+1030', 'LIGT' => '+1000', 'LINT' => '+1400', 72 'LKT' => '+0600', 'LST' => 'local', 'LT' => 'local', 73 'M' => '+1200', 'MAGST' => '+1200', 'MAGT' => '+1100', 74 'MAL' => '+0800', 'MART' => '-0930', 'MAT' => '+0300', 75 'MAWT' => '+0600', 'MDT' => '-0600', 'MED' => '+0200', 76 'MEDST' => '+0200', 'MEST' => '+0200', 'MESZ' => '+0200', 77 'MET' => 'Ambiguous', 'MEWT' => '+0100', 'MEX' => '-0600', 78 'MEZ' => '+0100', 'MHT' => '+1200', 'MMT' => '+0630', 79 'MPT' => '+1000', 'MSD' => '+0400', 'MSK' => '+0300', 80 'MSKS' => '+0400', 'MST' => '-0700', 'MT' => '+0830', 81 'MUT' => '+0400', 'MVT' => '+0500', 'MYT' => '+0800', 82 'N' => '-0100', 'NCT' => '+1100', 'NDT' => '-0230', 83 'NFT' => 'Ambiguous', 'NOR' => '+0100', 'NOVST' => '+0700', 84 'NOVT' => '+0600', 'NPT' => '+0545', 'NRT' => '+1200', 85 'NST' => 'Ambiguous', 'NSUT' => '+0630', 'NT' => '-1100', 86 'NUT' => '-1100', 'NZDT' => '+1300', 'NZST' => '+1200', 87 'NZT' => '+1200', 'O' => '-0200', 'OESZ' => '+0300', 88 'OEZ' => '+0200', 'OMSST' => '+0700', 'OMST' => '+0600', 89 'OZ' => 'local', 'P' => '-0300', 'PDT' => '-0700', 90 'PET' => '-0500', 'PETST' => '+1300', 'PETT' => '+1200', 91 'PGT' => '+1000', 'PHOT' => '+1300', 'PHT' => '+0800', 92 'PKT' => '+0500', 'PMDT' => '-0200', 'PMT' => '-0300', 93 'PNT' => '-0830', 'PONT' => '+1100', 'PST' => 'Ambiguous', 94 'PWT' => '+0900', 'PYST' => '-0300', 'PYT' => '-0400', 95 'Q' => '-0400', 'R' => '-0500', 'R1T' => '+0200', 96 'R2T' => '+0300', 'RET' => '+0400', 'ROK' => '+0900', 97 'S' => '-0600', 'SADT' => '+1030', 'SAST' => 'Ambiguous', 98 'SBT' => '+1100', 'SCT' => '+0400', 'SET' => '+0100', 99 'SGT' => '+0800', 'SRT' => '-0300', 'SST' => 'Ambiguous', 100 'SWT' => '+0100', 'T' => '-0700', 'TFT' => '+0500', 101 'THA' => '+0700', 'THAT' => '-1000', 'TJT' => '+0500', 102 'TKT' => '-1000', 'TMT' => '+0500', 'TOT' => '+1300', 103 'TRUT' => '+1000', 'TST' => '+0300', 'TUC ' => '+0000', 104 'TVT' => '+1200', 'U' => '-0800', 'ULAST' => '+0900', 105 'ULAT' => '+0800', 'USZ1' => '+0200', 'USZ1S' => '+0300', 106 'USZ3' => '+0400', 'USZ3S' => '+0500', 'USZ4' => '+0500', 107 'USZ4S' => '+0600', 'USZ5' => '+0600', 'USZ5S' => '+0700', 108 'USZ6' => '+0700', 'USZ6S' => '+0800', 'USZ7' => '+0800', 109 'USZ7S' => '+0900', 'USZ8' => '+0900', 'USZ8S' => '+1000', 110 'USZ9' => '+1000', 'USZ9S' => '+1100', 'UTZ' => '-0300', 111 'UYT' => '-0300', 'UZ10' => '+1100', 'UZ10S' => '+1200', 112 'UZ11' => '+1200', 'UZ11S' => '+1300', 'UZ12' => '+1200', 113 'UZ12S' => '+1300', 'UZT' => '+0500', 'V' => '-0900', 114 'VET' => '-0400', 'VLAST' => '+1100', 'VLAT' => '+1000', 115 'VTZ' => '-0200', 'VUT' => '+1100', 'W' => '-1000', 116 'WAKT' => '+1200', 'WAST' => 'Ambiguous', 'WAT' => '+0100', 117 'WEST' => '+0100', 'WESZ' => '+0100', 'WET' => '+0000', 118 'WETDST' => '+0100', 'WEZ' => '+0000', 'WFT' => '+1200', 119 'WGST' => '-0200', 'WGT' => '-0300', 'WIB' => '+0700', 120 'WIT' => '+0900', 'WITA' => '+0800', 'WST' => 'Ambiguous', 121 'WTZ' => '-0100', 'WUT' => '+0100', 'X' => '-1100', 122 'Y' => '-1200', 'YAKST' => '+1000', 'YAKT' => '+0900', 123 'YAPT' => '+1000', 'YDT' => '-0800', 'YEKST' => '+0600', 124 'YEKT' => '+0500', 'YST' => '-0900', 'Z' => '+0000', 125 'UTC' => '+0000', 126); 127 128sub new { 129 my $class = shift; 130 my %args = validate( 131 @_, { 132 pattern => { type => SCALAR | SCALARREF }, 133 time_zone => { type => SCALAR | OBJECT, optional => 1 }, 134 locale => { type => SCALAR | OBJECT, default => 'English' }, 135 on_error => { type => SCALAR | CODEREF, default => 'undef' }, 136 diagnostic => { type => SCALAR, default => 0 }, 137 } 138 ); 139 140 croak( 141 "The value supplied to on_error must be either 'croak', 'undef' or a code reference." 142 ) 143 unless ref( $args{on_error} ) eq 'CODE' 144 or $args{on_error} eq 'croak' 145 or $args{on_error} eq 'undef'; 146 147 # Deal with locale 148 unless ( ref( $args{locale} ) ) { 149 my $locale = DateTime::Locale->load( $args{locale} ); 150 151 croak("Could not create locale from $args{locale}") unless $locale; 152 153 $args{_locale} = $locale; 154 } 155 else { 156 $args{_locale} = $args{locale}; 157 ( $args{locale} ) = ref( $args{_locale} ) =~ /::(\w+)[^:]+$/; 158 } 159 160 if ( $args{time_zone} ) { 161 unless ( ref( $args{time_zone} ) ) { 162 $args{time_zone} 163 = DateTime::TimeZone->new( name => $args{time_zone} ); 164 165 croak("Could not create time zone from $args{time_zone}") 166 unless $args{time_zone}; 167 } 168 $args{set_time_zone} = $args{time_zone}; 169 } 170 else { 171 $args{time_zone} = DateTime::TimeZone->new( name => 'floating' ); 172 $args{set_time_zone} = ''; 173 } 174 175 my $self = bless \%args, $class; 176 177 # Deal with the parser 178 $self->{parser} = $self->_build_parser( $args{pattern} ); 179 if ( $self->{parser} =~ /(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/ ) { 180 croak("Unidentified token in pattern: $1 in $self->{pattern}"); 181 } 182 183 return $self; 184} 185 186sub pattern { 187 my $self = shift; 188 my $pattern = shift; 189 190 if ($pattern) { 191 my $possible_parser = $self->_build_parser($pattern); 192 if ( $possible_parser =~ /(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/ ) { 193 $self->local_carp( 194 "Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact." 195 ) and return undef; 196 } 197 else { 198 $self->{parser} = $possible_parser; 199 $self->{pattern} = $pattern; 200 } 201 } 202 return $self->{pattern}; 203} 204 205sub locale { 206 my $self = shift; 207 my $locale = shift; 208 209 if ($locale) { 210 my $possible_locale = DateTime::Locale->load($locale); 211 unless ($possible_locale) { 212 $self->local_carp( 213 "Could not create locale from $locale. Leaving old locale intact." 214 ) and return undef; 215 } 216 else { 217 $self->{locale} = $locale; 218 $self->{_locale} = $possible_locale; 219 220 # When the locale changes we need to rebuild the parser 221 $self->{parser} = $self->_build_parser( $self->{pattern} ); 222 } 223 } 224 return $self->{locale}; 225} 226 227sub time_zone { 228 my $self = shift; 229 my $time_zone = shift; 230 231 if ($time_zone) { 232 my $possible_time_zone 233 = DateTime::TimeZone->new( name => $time_zone ); 234 unless ($possible_time_zone) { 235 $self->local_carp( 236 "Could not create time zone from $time_zone. Leaving old time zone intact." 237 ) and return undef; 238 } 239 else { 240 $self->{time_zone} = $possible_time_zone; 241 $self->{set_time_zone} = $self->{time_zone}; 242 } 243 } 244 return $self->{time_zone}->name; 245} 246 247sub parse_datetime { 248 my ( $self, $time_string ) = @_; 249 250 local $^W = undef; 251 252 # Variables from the parser 253 my ( 254 $dow_name, $month_name, $century, $day, 255 $hour_24, $hour_12, $doy, $month, 256 $minute, $ampm, $second, $week_sun_0, 257 $dow_sun_0, $dow_mon_1, $week_mon_1, $year_100, 258 $year, $iso_week_year_100, $iso_week_year, 259 $epoch, $tz_offset, $timezone, $tz_olson, 260 $nanosecond, $ce_year, 261 262 $doy_dt, $epoch_dt, $use_timezone, $set_time_zone, 263 ); 264 265 # Variables for DateTime 266 my ( 267 $Year, $Month, $Day, 268 $Hour, $Minute, $Second, $Nanosecond, 269 $Am, $Pm 270 ) = (); 271 272 # Run the parser 273 my $parser = $self->{parser}; 274 eval($parser); 275 die $@ if $@; 276 277 if ( $self->{diagnostic} ) { 278 print qq| 279 280Entered = $time_string 281Parser = $parser 282 283dow_name = $dow_name 284month_name = $month_name 285century = $century 286day = $day 287hour_24 = $hour_24 288hour_12 = $hour_12 289doy = $doy 290month = $month 291minute = $minute 292ampm = $ampm 293second = $second 294nanosecond = $nanosecond 295week_sun_0 = $week_sun_0 296dow_sun_0 = $dow_sun_0 297dow_mon_1 = $dow_mon_1 298week_mon_1 = $week_mon_1 299year_100 = $year_100 300year = $year 301ce_year = $ce_year 302tz_offset = $tz_offset 303tz_olson = $tz_olson 304timezone = $timezone 305epoch = $epoch 306iso_week_year = $iso_week_year 307iso_week_year_100 = $iso_week_year_100 308 309 |; 310 311 } 312 313 $self->local_croak("Your datetime does not match your pattern.") 314 and return undef 315 if ( ( $self->{parser} =~ /\$dow_name\b/ and $dow_name eq '' ) 316 or ( $self->{parser} =~ /\$month_name\b/ and $month_name eq '' ) 317 or ( $self->{parser} =~ /\$century\b/ and $century eq '' ) 318 or ( $self->{parser} =~ /\$day\b/ and $day eq '' ) 319 or ( $self->{parser} =~ /\$hour_24\b/ and $hour_24 eq '' ) 320 or ( $self->{parser} =~ /\$hour_12\b/ and $hour_12 eq '' ) 321 or ( $self->{parser} =~ /\$doy\b/ and $doy eq '' ) 322 or ( $self->{parser} =~ /\$month\b/ and $month eq '' ) 323 or ( $self->{parser} =~ /\$minute\b/ and $minute eq '' ) 324 or ( $self->{parser} =~ /\$ampm\b/ and $ampm eq '' ) 325 or ( $self->{parser} =~ /\$second\b/ and $second eq '' ) 326 or ( $self->{parser} =~ /\$nanosecond\b/ and $nanosecond eq '' ) 327 or ( $self->{parser} =~ /\$week_sun_0\b/ and $week_sun_0 eq '' ) 328 or ( $self->{parser} =~ /\$dow_sun_0\b/ and $dow_sun_0 eq '' ) 329 or ( $self->{parser} =~ /\$dow_mon_1\b/ and $dow_mon_1 eq '' ) 330 or ( $self->{parser} =~ /\$week_mon_1\b/ and $week_mon_1 eq '' ) 331 or ( $self->{parser} =~ /\$year_100\b/ and $year_100 eq '' ) 332 or ( $self->{parser} =~ /\$year\b/ and $year eq '' ) 333 or ( $self->{parser} =~ /\$ce_year\b/ and $ce_year eq '' ) 334 or ( $self->{parser} =~ /\$tz_offset\b/ and $tz_offset eq '' ) 335 or ( $self->{parser} =~ /\$tz_olson\b/ and $tz_olson eq '' ) 336 or ( $self->{parser} =~ /\$timezone\b/ and $timezone eq '' ) 337 or ( $self->{parser} =~ /\$epoch\b/ and $epoch eq '' ) ); 338 339 # Create a timezone to work with 340 if ($tz_offset) { 341 $use_timezone = $tz_offset; 342 } 343 344 if ($timezone) { 345 $self->local_croak("I don't recognise the timezone $timezone.") 346 and return undef 347 unless $ZONEMAP{$timezone}; 348 $self->local_croak("The timezone '$timezone' is ambiguous.") 349 and return undef 350 if $ZONEMAP{$timezone} eq 'Ambiguous' 351 and not( $tz_offset or $tz_olson ); 352 $self->local_croak( 353 "Your timezones ('$tz_offset' and '$timezone') do not match.") 354 and return undef 355 if $tz_offset 356 and $ZONEMAP{$timezone} ne 'Ambiguous' 357 and $ZONEMAP{$timezone} != $tz_offset; 358 $use_timezone = $ZONEMAP{$timezone} 359 if $ZONEMAP{$timezone} ne 'Ambiguous'; 360 } 361 362 if ($tz_olson) { 363 my $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) }; 364 if ( not $tz ) { 365 print 366 "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n" 367 if $self->{diagnostic}; 368 $tz_olson = ucfirst lc $tz_olson; 369 $tz_olson =~ s|([/_])(\w)|$1\U$2|g; 370 print " Trying $tz_olson.\n" if $self->{diagnostic}; 371 $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) }; 372 } 373 $self->local_croak("I don't recognise the time zone '$tz_olson'.") 374 and return undef 375 unless $tz; 376 $use_timezone = $set_time_zone = $tz; 377 378 } 379 380 $use_timezone = $self->{time_zone} unless ($use_timezone); 381 382 print "Using timezone $use_timezone.\n" if $self->{diagnostic}; 383 384 # If there's an epoch, we're done. Just need to check all the others 385 if ($epoch) { 386 $epoch_dt = DateTime->from_epoch( 387 epoch => $epoch, 388 time_zone => $use_timezone 389 ); 390 391 $Year = $epoch_dt->year; 392 $Month = $epoch_dt->month; 393 $Day = $epoch_dt->day; 394 395 $Hour = $epoch_dt->hour; 396 $Minute = $epoch_dt->minute; 397 $Second = $epoch_dt->second; 398 $Nanosecond = $epoch_dt->nanosecond; 399 400 print $epoch_dt->strftime("Epoch: %D %T.%N\n") if $self->{diagnostic}; 401 } 402 403 # Work out the year we're working with: 404 if ($year_100) { 405 if ($century) { 406 $Year = ( ( $century * 100 ) - 0 ) + $year_100; 407 } 408 else { 409 print "No century, guessing for $year_100" if $self->{diagnostic}; 410 if ( $year_100 >= 69 and $year_100 <= 99 ) { 411 print "Guessed 1900s" if $self->{diagnostic}; 412 $Year = 1900 + $year_100; 413 } 414 else { 415 print "Guessed 2000s" if $self->{diagnostic}; 416 $Year = 2000 + $year_100; 417 } 418 } 419 } 420 if ($year) { 421 $self->local_croak( 422 "Your two year values ($year_100 and $year) do not match.") 423 and return undef 424 if ( $Year && ( $year != $Year ) ); 425 $Year = $year; 426 } 427 if ($ce_year) { 428 $self->local_croak( 429 "Your two year values ($ce_year and $year) do not match.") 430 and return undef 431 if ( $Year && ( $ce_year != $Year ) ); 432 $Year = $ce_year; 433 } 434 $self->local_croak("Your year value does not match your epoch.") 435 and return undef 436 if $epoch_dt 437 and $Year 438 and $Year != $epoch_dt->year; 439 440 # Work out which month we want 441 # Month names 442 if ($month_name) { 443 $self->local_croak( 444 "There is no use providing a month name ($month_name) without providing a year." 445 ) 446 and return undef 447 unless $Year; 448 my $month_count = 0; 449 my $month_number = 0; 450 foreach my $month ( @{ $self->{_locale}->month_format_wide } ) { 451 $month_count++; 452 453 if ( lc $month eq lc $month_name ) { 454 $month_number = $month_count; 455 last; 456 } 457 } 458 unless ($month_number) { 459 my $month_count = 0; 460 foreach 461 my $month ( @{ $self->{_locale}->month_format_abbreviated } ) 462 { 463 $month_count++; 464 465 # When abbreviating, sometimes there's a period, sometimes not. 466 $month =~ s/\.$//; 467 $month_name =~ s/\.$//; 468 if ( lc $month eq lc $month_name ) { 469 $month_number = $month_count; 470 last; 471 } 472 } 473 } 474 unless ($month_number) { 475 $self->local_croak( 476 "$month_name is not a recognised month in this locale.") 477 and return undef; 478 } 479 $Month = $month_number; 480 } 481 if ($month) { 482 $self->local_croak( 483 "There is no use providing a month without providing a year.") 484 and return undef 485 unless $Year; 486 $self->local_croak("$month is too large to be a month of the year.") 487 and return undef 488 unless $month <= 12; 489 $self->local_croak( 490 "Your two month values ($month_name and $month) do not match.") 491 and return undef 492 if $Month 493 and $month != $Month; 494 $Month = $month; 495 } 496 $self->local_croak("Your month value does not match your epoch.") 497 and return undef 498 if $epoch_dt 499 and $Month 500 and $Month != $epoch_dt->month; 501 if ($doy) { 502 $self->local_croak( 503 "There is no use providing a day of the year without providing a year." 504 ) 505 and return undef 506 unless $Year; 507 $doy_dt = eval { 508 DateTime->from_day_of_year( 509 year => $Year, day_of_year => $doy, 510 time_zone => $use_timezone 511 ); 512 }; 513 $self->local_croak("Day of year $Year-$doy is not valid") 514 and return undef 515 if $@; 516 517 my $month = $doy_dt->month; 518 $self->local_croak( "Your day of the year ($doy - in " 519 . $doy_dt->month_name 520 . ") is not in your month ($Month)" ) 521 and return undef 522 if $Month 523 and $month != $Month; 524 $Month = $month; 525 } 526 $self->local_croak("Your day of the year does not match your epoch.") 527 and return undef 528 if $epoch_dt 529 and $doy_dt 530 and $doy_dt->doy != $epoch_dt->doy; 531 532 # Day of the month 533 $self->local_croak("$day is too large to be a day of the month.") 534 and return undef 535 unless $day <= 31; 536 $self->local_croak( 537 "Your day of the month ($day) does not match your day of the year.") 538 and return undef 539 if $doy_dt 540 and $day 541 and $day != $doy_dt->day; 542 $Day ||= 543 ($day) ? $day 544 : ($doy_dt) ? $doy_dt->day 545 : ''; 546 if ($Day) { 547 $self->local_croak( 548 "There is no use providing a day without providing a month and year." 549 ) 550 and return undef 551 unless $Year 552 and $Month; 553 my $dt = eval { 554 DateTime->new( 555 year => $Year + 0, month => $Month + 0, day => $Day + 0, 556 hour => 12, time_zone => $use_timezone 557 ); 558 }; 559 $self->local_croak("Datetime $Year-$Month-$Day is not a valid date") 560 and return undef 561 if $@; 562 $self->local_croak("There is no day $Day in $dt->month_name, $Year") 563 and return undef 564 unless $dt->month == $Month; 565 } 566 $self->local_croak("Your day of the month does not match your epoch.") 567 and return undef 568 if $epoch_dt 569 and $Day 570 and $Day != $epoch_dt->day; 571 572 # Hour of the day 573 $self->local_croak("$hour_24 is too large to be an hour of the day.") 574 and return undef 575 unless $hour_24 <= 23; #OK so leap seconds will break! 576 $self->local_croak("$hour_12 is too large to be an hour of the day.") 577 and return undef 578 unless $hour_12 <= 12; 579 $self->local_croak( 580 "You must specify am or pm for 12 hour clocks ($hour_12|$ampm).") 581 and return undef 582 if ( $hour_12 && ( !$ampm ) ); 583 ( $Am, $Pm ) = @{ $self->{_locale}->am_pm_abbreviated }; 584 if ( lc $ampm eq lc $Pm ) { 585 if ($hour_12) { 586 $hour_12 += 12 if $hour_12 and $hour_12 != 12; 587 } 588 $self->local_croak( 589 "Your am/pm value ($ampm) does not match your hour ($hour_24)") 590 and return undef 591 if $hour_24 592 and $hour_24 < 12; 593 } 594 elsif ( lc $ampm eq lc $Am ) { 595 if ($hour_12) { 596 $hour_12 = 0 if $hour_12 == 12; 597 } 598 $self->local_croak( 599 "Your am/pm value ($ampm) does not match your hour ($hour_24)") 600 and return undef 601 if $hour_24 >= 12; 602 } 603 if ( $hour_12 and $hour_24 ) { 604 $self->local_croak( 605 "You have specified mis-matching 12 and 24 hour clock information" 606 ) 607 and return undef 608 unless $hour_12 == $hour_24; 609 $Hour = $hour_24; 610 } 611 elsif ($hour_12) { 612 $Hour = $hour_12; 613 } 614 elsif ($hour_24) { 615 $Hour = $hour_24; 616 } 617 $self->local_croak("Your hour does not match your epoch.") 618 and return undef 619 if $epoch_dt 620 and $Hour 621 and $Hour != $epoch_dt->hour; 622 print "Set hour to $Hour.\n" if $self->{diagnostic}; 623 624 # Minutes 625 $self->local_croak("$minute is too large to be a minute.") 626 and return undef 627 unless $minute <= 59; 628 $Minute ||= $minute; 629 $self->local_croak("Your minute does not match your epoch.") 630 and return undef 631 if $epoch_dt 632 and $Minute 633 and $Minute != $epoch_dt->minute; 634 print "Set minute to $Minute.\n" if $self->{diagnostic}; 635 636 # Seconds 637 $self->local_croak("$second is too large to be a second.") 638 and return undef 639 unless $second <= 59; #OK so leap seconds will break! 640 $Second ||= $second; 641 $self->local_croak("Your second does not match your epoch.") 642 and return undef 643 if $epoch_dt 644 and $Second 645 and $Second != $epoch_dt->second; 646 print "Set second to $Second.\n" if $self->{diagnostic}; 647 648 # Nanoeconds 649 $self->local_croak("$nanosecond is too large to be a nanosecond.") 650 and return undef 651 unless length($nanosecond) <= 9; 652 $Nanosecond ||= $nanosecond; 653 $Nanosecond .= '0' while length($Nanosecond) < 9; 654 655 # Epoch doesn't return nanoseconds 656 # croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond; 657 print "Set nanosecond to $Nanosecond.\n" if $self->{diagnostic}; 658 659 my $potential_return = eval { 660 DateTime->new( 661 year => ( $Year || 1 ) + 0, 662 month => ( $Month || 1 ) + 0, 663 day => ( $Day || 1 ) + 0, 664 665 hour => ( $Hour || 0 ) + 0, 666 minute => ( $Minute || 0 ) + 0, 667 second => ( $Second || 0 ) + 0, 668 nanosecond => ( $Nanosecond || 0 ) + 0, 669 670 locale => $self->{_locale}, 671 time_zone => $use_timezone, 672 ); 673 }; 674 $self->local_croak("Datetime is not a valid date") and return undef if $@; 675 676 $self->local_croak( 677 "Your day of the week ($dow_mon_1) does not match the date supplied: " 678 . $potential_return->ymd ) 679 and return undef 680 if $dow_mon_1 681 and $potential_return->dow != $dow_mon_1; 682 683 $self->local_croak( 684 "Your day of the week ($dow_sun_0) does not match the date supplied: " 685 . $potential_return->ymd ) 686 and return undef 687 if $dow_sun_0 688 and ( $potential_return->dow % 7 ) != $dow_sun_0; 689 690 if ($dow_name) { 691 my $dow_count = 0; 692 my $dow_number = 0; 693 foreach my $dow ( @{ $self->{_locale}->day_format_wide } ) { 694 $dow_count++; 695 if ( lc $dow eq lc $dow_name ) { 696 $dow_number = $dow_count; 697 last; 698 } 699 } 700 unless ($dow_number) { 701 my $dow_count = 0; 702 foreach my $dow ( @{ $self->{_locale}->day_format_abbreviated } ) 703 { 704 $dow_count++; 705 if ( lc $dow eq lc $dow_name ) { 706 $dow_number = $dow_count; 707 last; 708 } 709 } 710 } 711 unless ($dow_number) { 712 $self->local_croak( 713 "$dow_name is not a recognised day in this locale.") 714 and return undef; 715 } 716 $self->local_croak( 717 "Your day of the week ($dow_name) does not match the date supplied: " 718 . $potential_return->ymd ) 719 and return undef 720 if $dow_number 721 and $potential_return->dow != $dow_number; 722 } 723 724 $self->local_croak( 725 "Your week number ($week_sun_0) does not match the date supplied: " 726 . $potential_return->ymd ) 727 and return undef 728 if $week_sun_0 729 and $potential_return->strftime('%U') != $week_sun_0; 730 $self->local_croak( 731 "Your week number ($week_mon_1) does not match the date supplied: " 732 . $potential_return->ymd ) 733 and return undef 734 if $week_mon_1 735 and $potential_return->strftime('%W') != $week_mon_1; 736 $self->local_croak( 737 "Your ISO week year ($iso_week_year) does not match the date supplied: " 738 . $potential_return->ymd ) 739 and return undef 740 if $iso_week_year 741 and $potential_return->strftime('%G') != $iso_week_year; 742 $self->local_croak( 743 "Your ISO week year ($iso_week_year_100) does not match the date supplied: " 744 . $potential_return->ymd ) 745 and return undef 746 if $iso_week_year_100 747 and $potential_return->strftime('%g') != $iso_week_year_100; 748 749 # Move into the timezone in the object - if there is one 750 print "Potential Datetime: " 751 . $potential_return->strftime("%F %T %z %Z") . "\n" 752 if $self->{diagnostic}; 753 print "Setting timezone: " . $self->{set_time_zone} . "\n" 754 if $self->{diagnostic}; 755 if ( $self->{set_time_zone} ) { 756 $potential_return->set_time_zone( $self->{set_time_zone} ); 757 } 758 elsif ($set_time_zone) { 759 $potential_return->set_time_zone($set_time_zone); 760 } 761 print "Actual Datetime: " 762 . $potential_return->strftime("%F %T %z %Z") . "\n" 763 if $self->{diagnostic}; 764 765 return $potential_return; 766} 767 768sub parse_duration { 769 croak "DateTime::Format::Strptime doesn't do durations."; 770} 771 772sub format_datetime { 773 my ( $self, $dt ) = @_; 774 my $pattern = $self->pattern; 775 $pattern =~ s/%O/$dt->time_zone->name/eg; 776 return $dt->clone->set_locale( $self->locale )->strftime($pattern); 777} 778 779sub format_duration { 780 croak "DateTime::Format::Strptime doesn't do durations."; 781} 782 783sub _build_parser { 784 my $self = shift; 785 my $regex = my $field_list = shift; 786 if ( ref $regex eq 'Regexp' ) { 787 $field_list =~ s/^\(\?-xism:(.+)\)$/$1/; 788 } 789 my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g; 790 $field_list = join( '', @fields ); 791 792 # Locale-ize the parser 793 my $ampm_list = join( '|', @{ $self->{_locale}->am_pm_abbreviated } ); 794 $ampm_list .= '|' . lc $ampm_list; 795 796 my $default_date_format = $self->{_locale}->glibc_date_format; 797 my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g; 798 $default_date_format = join( '', @locale_format ); 799 800 my $default_time_format = $self->{_locale}->glibc_time_format; 801 @locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g; 802 $default_time_format = join( '', @locale_format ); 803 804 my $default_datetime_format = $self->{_locale}->glibc_datetime_format; 805 @locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g; 806 $default_datetime_format = join( '', @locale_format ); 807 808 print 809 "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n" 810 if $self->{diagnostic}; 811 812 $regex =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g; 813 $field_list =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g; 814 815 $regex =~ s/%c/$self->{_locale}->glibc_datetime_format/eg; 816 $field_list =~ s/%c/$default_datetime_format/eg; 817 818 # %c is the locale's default datetime format. 819 820 $regex =~ s/%x/$self->{_locale}->glibc_date_format/eg; 821 $field_list =~ s/%x/$default_date_format/eg; 822 823 # %x is the locale's default date format. 824 825 $regex =~ s/%X/$self->{_locale}->glibc_time_format/eg; 826 $field_list =~ s/%X/$default_time_format/eg; 827 828 # %x is the locale's default time format. 829 830 if ( ref $regex ne 'Regexp' ) { 831 $regex = quotemeta($regex); 832 $regex =~ s/(?<!\\)\\%/%/g; 833 $regex =~ s/%\\\{([^\}]+)\\\}/%{$1}/g; 834 } 835 836 $regex =~ s/%T/%H:%M:%S/g; 837 $field_list =~ s/%T/%H%M%S/g; 838 839 # %T is the time as %H:%M:%S. 840 841 $regex =~ s/%r/%I:%M:%S %p/g; 842 $field_list =~ s/%r/%I%M%S%p/g; 843 844 #is the time as %I:%M:%S %p. 845 846 $regex =~ s/%R/%H:%M/g; 847 $field_list =~ s/%R/%H%M/g; 848 849 #is the time as %H:%M. 850 851 $regex =~ s|%D|%m\\/%d\\/%y|g; 852 $field_list =~ s|%D|%m%d%y|g; 853 854 #is the same as %m/%d/%y. 855 856 $regex =~ s|%F|%Y\\-%m\\-%d|g; 857 $field_list =~ s|%F|%Y%m%d|g; 858 859 #is the same as %Y-%m-%d - the ISO date format. 860 861 my $day_re = join( 862 '|', 863 map { quotemeta $_ } 864 sort { length $b <=> length $a } 865 grep( /\W/, @{ $self->{_locale}->day_format_wide }, 866 @{ $self->{_locale}->day_format_abbreviated } ) 867 ); 868 $day_re .= '|' if $day_re; 869 $regex =~ s/%a/($day_re\\w+)/gi; 870 $field_list =~ s/%a/#dow_name#/gi; 871 872 # %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified. 873 # %A is the same as %a. 874 875 my $month_re = join( 876 '|', 877 map { quotemeta $_ } 878 sort { length $b <=> length $a } 879 grep( /\s|\d/, @{ $self->{_locale}->month_format_wide }, 880 @{ $self->{_locale}->month_format_abbreviated } ) 881 ); 882 $month_re .= '|' if $month_re; 883 $month_re .= '[^\\s\\d]+'; 884 $regex =~ s/%[bBh]/($month_re)/g; 885 $field_list =~ s/%[bBh]/#month_name#/g; 886 887 #is the month, using the locale's month names; either the abbreviated or full name may be specified. 888 # %B is the same as %b. 889 # %h is the same as %b. 890 891 #s/%c//g; 892 #is replaced by the locale's appropriate date and time representation. 893 894 $regex =~ s/%C/([\\d ]?\\d)/g; 895 $field_list =~ s/%C/#century#/g; 896 897 #is the century number [0,99]; leading zeros are permitted by not required. 898 899 $regex =~ s/%[de]/([\\d ]?\\d)/g; 900 $field_list =~ s/%[de]/#day#/g; 901 902 #is the day of the month [1,31]; leading zeros are permitted but not required. 903 #%e is the same as %d. 904 905 $regex =~ s/%[Hk]/([\\d ]?\\d)/g; 906 $field_list =~ s/%[Hk]/#hour_24#/g; 907 908 #is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required. 909 # %k is the same as %H 910 911 $regex =~ s/%g/([\\d ]?\\d)/g; 912 $field_list =~ s/%g/#iso_week_year_100#/g; 913 914 # The year corresponding to the ISO week number, but without the century (0-99). 915 916 $regex =~ s/%G/(\\d{4})/g; 917 $field_list =~ s/%G/#iso_week_year#/g; 918 919 # The year corresponding to the ISO week number. 920 921 $regex =~ s/%[Il]/([\\d ]?\\d)/g; 922 $field_list =~ s/%[Il]/#hour_12#/g; 923 924 #is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required. 925 # %l is the same as %I. 926 927 $regex =~ s/%j/(\\d{1,3})/g; 928 $field_list =~ s/%j/#doy#/g; 929 930 #is the day of the year [1,366]; leading zeros are permitted but not required. 931 932 $regex =~ s/%m/([\\d ]?\\d)/g; 933 $field_list =~ s/%m/#month#/g; 934 935 #is the month number [1-12]; leading zeros are permitted but not required. 936 937 $regex =~ s/%M/([\\d ]?\\d)/g; 938 $field_list =~ s/%M/#minute#/g; 939 940 #is the minute [0-59]; leading zeros are permitted but not required. 941 942 $regex =~ s/%[nt]/\\s+/g; 943 $field_list =~ s/%[nt]//g; 944 945 # %n is any white space. 946 # %t is any white space. 947 948 $regex =~ s/%p/($ampm_list)/gi; 949 $field_list =~ s/%p/#ampm#/gi; 950 951 # %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock. 952 953 $regex =~ s/%s/(\\d+)/g; 954 $field_list =~ s/%s/#epoch#/g; 955 956 # %s is the seconds since the epoch 957 958 $regex =~ s/%S/([\\d ]?\\d)/g; 959 $field_list =~ s/%S/#second#/g; 960 961 # %S is the seconds [0-61]; leading zeros are permitted but not required. 962 963 $regex =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg; 964 $field_list =~ s/%\d*N/#nanosecond#/g; 965 966 # %N is the nanoseconds (or sub seconds really) 967 968 $regex =~ s/%U/([\\d ]?\\d)/g; 969 $field_list =~ s/%U/#week_sun_0#/g; 970 971 # %U is the week number of the year (Sunday as the first day of the week) as a decimal number [0-53]; leading zeros are permitted but not required. 972 973 $regex =~ s/%w/([0-6])/g; 974 $field_list =~ s/%w/#dow_sun_0#/g; 975 976 # is the weekday as a decimal number [0-6], with 0 representing Sunday. 977 978 $regex =~ s/%u/([1-7])/g; 979 $field_list =~ s/%u/#dow_mon_1#/g; 980 981 # is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime. 982 983 $regex =~ s/%W/([\\d ]?\\d)/g; 984 $field_list =~ s/%W/#week_mon_1#/g; 985 986 #is the week number of the year (Monday as the first day of the week) as a decimal number [0,53]; leading zeros are permitted but not required. 987 988 $regex =~ s/%y/([\\d ]?\\d)/g; 989 $field_list =~ s/%y/#year_100#/g; 990 991 # is the year within the century. When a century is not otherwise specified, values in the range 69-99 refer to years in the twentieth century (1969 to 1999 inclusive); values in the range 0-68 refer to years in the twenty-first century (2000-2068 inclusive). Leading zeros are permitted but not required. 992 993 $regex =~ s/%Y/(\\d{4})/g; 994 $field_list =~ s/%Y/#year#/g; 995 996 # is the year including the century (for example, 1998). 997 998 $regex =~ s|%z|([+-]\\d{4})|g; 999 $field_list =~ s/%z/#tz_offset#/g; 1000 1001 # Timezone Offset. 1002 1003 $regex =~ s|%Z|(\\w+)|g; 1004 $field_list =~ s/%Z/#timezone#/g; 1005 1006 # The short timezone name. 1007 1008 $regex =~ s|%O|(\\w+\\/\\w+)|g; 1009 $field_list =~ s/%O/#tz_olson#/g; 1010 1011 # The Olson timezone name. 1012 1013 $regex =~ s|%\{(\w+)\}|(DateTime->can($1)) ? "(.+)" : ".+"|eg; 1014 $field_list =~ s|(%\{(\w+)\})|(DateTime->can($2)) ? "#$2#" : $1 |eg; 1015 1016 # Any function in DateTime. 1017 1018 $regex =~ s/__ESCAPED_PERCENT_SIGN_MARKER__/\\%/g; 1019 $field_list =~ s/__ESCAPED_PERCENT_SIGN_MARKER__//g; 1020 1021 # is replaced by %. 1022 #print $regex; 1023 1024 $field_list =~ s/#([a-z0-9_]+)#/\$$1, /gi; 1025 $field_list =~ s/,\s*$//; 1026 1027 return qq|($field_list) = \$time_string =~ /$regex/|; 1028} 1029 1030# Utility functions 1031 1032sub local_croak { 1033 my $self = $_[0]; 1034 return &{ $self->{on_error} }(@_) if ref( $self->{on_error} ); 1035 croak( $_[1] ) if $self->{on_error} eq 'croak'; 1036 $self->{errmsg} = $_[1]; 1037 return ( $self->{on_error} eq 'undef' ); 1038} 1039 1040sub local_carp { 1041 my $self = $_[0]; 1042 return &{ $self->{on_error} }(@_) if ref( $self->{on_error} ); 1043 carp( $_[1] ) if $self->{on_error} eq 'croak'; 1044 $self->{errmsg} = $_[1]; 1045 return ( $self->{on_error} eq 'undef' ); 1046} 1047 1048sub errmsg { 1049 $_[0]->{errmsg}; 1050} 1051 1052# Exportable functions: 1053 1054sub strftime { 1055 my ( $pattern, $dt ) = @_; 1056 return $dt->strftime($pattern); 1057} 1058 1059sub strptime { 1060 my ( $pattern, $time_string ) = @_; 1061 return DateTime::Format::Strptime->new( 1062 pattern => $pattern, 1063 on_error => 'croak' 1064 )->parse_datetime($time_string); 1065} 1066 10671; 1068 1069# ABSTRACT: Parse and format strp and strf time patterns 1070 1071__END__ 1072 1073=pod 1074 1075=head1 NAME 1076 1077DateTime::Format::Strptime - Parse and format strp and strf time patterns 1078 1079=head1 VERSION 1080 1081version 1.54 1082 1083=head1 SYNOPSIS 1084 1085 use DateTime::Format::Strptime; 1086 1087 my $strp = DateTime::Format::Strptime->new( 1088 pattern => '%T', 1089 locale => 'en_AU', 1090 time_zone => 'Australia/Melbourne', 1091 ); 1092 1093 my $dt = $strp->parse_datetime('23:16:42'); 1094 1095 $strp->format_datetime($dt); 1096 1097 # 23:16:42 1098 1099 # Croak when things go wrong: 1100 my $strp = DateTime::Format::Strptime->new( 1101 pattern => '%T', 1102 locale => 'en_AU', 1103 time_zone => 'Australia/Melbourne', 1104 on_error => 'croak', 1105 ); 1106 1107 $newpattern = $strp->pattern('%Q'); 1108 1109 # Unidentified token in pattern: %Q in %Q at line 34 of script.pl 1110 1111 # Do something else when things go wrong: 1112 my $strp = DateTime::Format::Strptime->new( 1113 pattern => '%T', 1114 locale => 'en_AU', 1115 time_zone => 'Australia/Melbourne', 1116 on_error => \&phone_police, 1117 ); 1118 1119=head1 DESCRIPTION 1120 1121This module implements most of C<strptime(3)>, the POSIX function that 1122is the reverse of C<strftime(3)>, for C<DateTime>. While C<strftime> 1123takes a C<DateTime> and a pattern and returns a string, C<strptime> takes 1124a string and a pattern and returns the C<DateTime> object 1125associated. 1126 1127=head1 CONSTRUCTOR 1128 1129=over 4 1130 1131=item * new( pattern => $strptime_pattern ) 1132 1133Creates the format object. You must specify a pattern, you can also 1134specify a C<time_zone> and a C<locale>. If you specify a time zone 1135then any resulting C<DateTime> object will be in that time zone. If you 1136do not specify a C<time_zone> parameter, but there is a time zone in the 1137string you pass to C<parse_datetime>, then the resulting C<DateTime> will 1138use that time zone. 1139 1140You can optionally use an on_error parameter. This parameter has three 1141valid options: 1142 1143=over 4 1144 1145=item * 'undef' 1146 1147(not undef, 'undef', it's a string not an undefined value) 1148 1149This is the default behavior. The module will return undef whenever it gets 1150upset. The error can be accessed using the C<< $object->errmsg >> method. 1151This is the ideal behaviour for interactive use where a user might provide an 1152illegal pattern or a date that doesn't match the pattern. 1153 1154=item * 'croak' 1155 1156(not croak, 'croak', it's a string, not a function) 1157 1158This used to be the default behaviour. The module will croak with an 1159error message whenever it gets upset. 1160 1161=item * sub{...} or \&subname 1162 1163When given a code ref, the module will call that sub when it gets upset. 1164The sub receives two parameters: the object and the error message. Using 1165these two it is possible to emulate the 'undef' behavior. (Returning a 1166true value causes the method to return undef. Returning a false value 1167causes the method to bravely continue): 1168 1169 sub { $_[0]->{errmsg} = $_[1]; 1 }, 1170 1171=back 1172 1173=back 1174 1175=head1 METHODS 1176 1177This class offers the following methods. 1178 1179=over 4 1180 1181=item * parse_datetime($string) 1182 1183Given a string in the pattern specified in the constructor, this method 1184will return a new C<DateTime> object. 1185 1186If given a string that doesn't match the pattern, the formatter will 1187croak or return undef, depending on the setting of on_error in the constructor. 1188 1189=item * format_datetime($datetime) 1190 1191Given a C<DateTime> object, this methods returns a string formatted in 1192the object's format. This method is synonymous with C<DateTime>'s 1193strftime method. 1194 1195=item * locale($locale) 1196 1197When given a locale or C<DateTime::Locale> object, this method sets 1198its locale appropriately. If the locale is not understood, the method 1199will croak or return undef (depending on the setting of on_error in 1200the constructor) 1201 1202If successful this method returns the current locale. (After 1203processing as above). 1204 1205=item * pattern($strptime_pattern) 1206 1207When given a pattern, this method sets the object's pattern. If the 1208pattern is invalid, the method will croak or return undef (depending on 1209the value of the C<on_error> parameter) 1210 1211If successful this method returns the current pattern. (After processing 1212as above) 1213 1214=item * time_zone($time_zone) 1215 1216When given a name, offset or C<DateTime::TimeZone> object, this method 1217sets the object's time zone. This effects the C<DateTime> object 1218returned by parse_datetime 1219 1220If the time zone is invalid, the method will croak or return undef 1221(depending on the value of the C<on_error> parameter) 1222 1223If successful this method returns the current time zone. (After processing 1224as above) 1225 1226=item * errmsg 1227 1228If the on_error behavior of the object is 'undef', error messages with 1229this method so you can work out why things went wrong. 1230 1231This code emulates a C<$DateTime::Format::Strptime> with 1232the C<on_error> parameter equal to C<'croak'>: 1233 1234C<< $strp->pattern($pattern) or die $DateTime::Format::Strptime::errmsg >> 1235 1236=back 1237 1238=head1 EXPORTS 1239 1240There are no methods exported by default, however the following are 1241available: 1242 1243=over 4 1244 1245=item * strptime( $strptime_pattern, $string ) 1246 1247Given a pattern and a string this function will return a new C<DateTime> 1248object. 1249 1250=item * strftime( $strftime_pattern, $datetime ) 1251 1252Given a pattern and a C<DateTime> object this function will return a 1253formatted string. 1254 1255=back 1256 1257=head1 STRPTIME PATTERN TOKENS 1258 1259The following tokens are allowed in the pattern string for strptime 1260(parse_datetime): 1261 1262=over 4 1263 1264=item * %% 1265 1266The % character. 1267 1268=item * %a or %A 1269 1270The weekday name according to the current locale, in abbreviated form or 1271the full name. 1272 1273=item * %b or %B or %h 1274 1275The month name according to the current locale, in abbreviated form or 1276the full name. 1277 1278=item * %C 1279 1280The century number (0-99). 1281 1282=item * %d or %e 1283 1284The day of month (01-31). This will parse single digit numbers as well. 1285 1286=item * %D 1287 1288Equivalent to %m/%d/%y. (This is the American style date, very confusing 1289to non-Americans, especially since %d/%m/%y is widely used in Europe. 1290The ISO 8601 standard pattern is %F.) 1291 1292=item * %F 1293 1294Equivalent to %Y-%m-%d. (This is the ISO style date) 1295 1296=item * %g 1297 1298The year corresponding to the ISO week number, but without the century 1299(0-99). 1300 1301=item * %G 1302 1303The year corresponding to the ISO week number. 1304 1305=item * %H 1306 1307The hour (00-23). This will parse single digit numbers as well. 1308 1309=item * %I 1310 1311The hour on a 12-hour clock (1-12). 1312 1313=item * %j 1314 1315The day number in the year (1-366). 1316 1317=item * %m 1318 1319The month number (01-12). This will parse single digit numbers as well. 1320 1321=item * %M 1322 1323The minute (00-59). This will parse single digit numbers as well. 1324 1325=item * %n 1326 1327Arbitrary whitespace. 1328 1329=item * %N 1330 1331Nanoseconds. For other sub-second values use C<%[number]N>. 1332 1333=item * %p 1334 1335The equivalent of AM or PM according to the locale in use. (See 1336L<DateTime::Locale>) 1337 1338=item * %r 1339 1340Equivalent to %I:%M:%S %p. 1341 1342=item * %R 1343 1344Equivalent to %H:%M. 1345 1346=item * %s 1347 1348Number of seconds since the Epoch. 1349 1350=item * %S 1351 1352The second (0-60; 60 may occur for leap seconds. See 1353L<DateTime::LeapSecond>). 1354 1355=item * %t 1356 1357Arbitrary whitespace. 1358 1359=item * %T 1360 1361Equivalent to %H:%M:%S. 1362 1363=item * %U 1364 1365The week number with Sunday the first day of the week (0-53). The first 1366Sunday of January is the first day of week 1. 1367 1368=item * %u 1369 1370The weekday number (1-7) with Monday = 1. This is the C<DateTime> standard. 1371 1372=item * %w 1373 1374The weekday number (0-6) with Sunday = 0. 1375 1376=item * %W 1377 1378The week number with Monday the first day of the week (0-53). The first 1379Monday of January is the first day of week 1. 1380 1381=item * %y 1382 1383The year within century (0-99). When a century is not otherwise specified 1384(with a value for %C), values in the range 69-99 refer to years in the 1385twentieth century (1969-1999); values in the range 00-68 refer to years in the 1386twenty-first century (2000-2068). 1387 1388=item * %Y 1389 1390The year, including century (for example, 1991). 1391 1392=item * %z 1393 1394An RFC-822/ISO 8601 standard time zone specification. (For example 1395+1100) [See note below] 1396 1397=item * %Z 1398 1399The timezone name. (For example EST -- which is ambiguous) [See note 1400below] 1401 1402=item * %O 1403 1404This extended token allows the use of Olson Time Zone names to appear 1405in parsed strings. B<NOTE>: This pattern cannot be passed to C<DateTime>'s 1406C<strftime()> method, but can be passed to C<format_datetime()>. 1407 1408=back 1409 1410=head1 AUTHOR EMERITUS 1411 1412This module was created by Rick Measham. 1413 1414=head1 BUGS 1415 1416Please report any bugs or feature requests to 1417C<bug-datetime-format-strptime@rt.cpan.org>, or through the web interface at 1418L<http://rt.cpan.org>. I will be notified, and then you'll automatically be 1419notified of progress on your bug as I make changes. 1420 1421=head1 SEE ALSO 1422 1423C<datetime@perl.org> mailing list. 1424 1425http://datetime.perl.org/ 1426 1427L<perl>, L<DateTime>, L<DateTime::TimeZone>, L<DateTime::Locale> 1428 1429=head1 AUTHORS 1430 1431=over 4 1432 1433=item * 1434 1435Dave Rolsky <autarch@urth.org> 1436 1437=item * 1438 1439Rick Measham <rickm@cpan.org> 1440 1441=back 1442 1443=head1 COPYRIGHT AND LICENSE 1444 1445This software is Copyright (c) 2013 by Dave Rolsky. 1446 1447This is free software, licensed under: 1448 1449 The Artistic License 2.0 (GPL Compatible) 1450 1451=cut 1452