File Coverage

blib/lib/Date/Parse.pm

Criterion	Covered	Total	%
statement	156	199	78.3
branch	140	224	62.5
condition	69	129	53.4
subroutine	10	11	90.9
pod	1	2	50.0
total	376	565	66.5

# Copyright (c) 1995-2009 Graham Barr. This program is free
# software; you can redistribute it and/or modify it under the same terms
# as Perl itself.

package Date::Parse;

require 5.000;
use strict;
use Time::Local;
use Carp;
use Time::Zone;
use Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(&strtotime &str2time &strptime);

our $VERSION = '2.34_03'; # TRIAL VERSION: generated
# ABSTRACT: Parse date strings into time values

my %month = (
    january   => 0,
    february  => 1,
    march     => 2,
    april     => 3,
    may       => 4,
    june      => 5,
    july      => 6,
    august    => 7,
    september => 8,
    sept      => 8,
    october   => 9,
    november  => 10,
    december  => 11,
    );

my %day = (
    sunday    => 0,
    monday    => 1,
    tuesday   => 2,
    tues      => 2,
    wednesday => 3,
    wednes    => 3,
    thursday  => 4,
    thur      => 4,
    thurs     => 4,
    friday    => 5,
    saturday  => 6,
    );

my @suf = (qw(th st nd rd th th th th th th)) x 3;
@suf[11,12,13] = qw(th th th);

#Abbreviations

map { $month{substr($_,0,3)} = $month{$_} } keys %month;
map { $day{substr($_,0,3)}   = $day{$_} }   keys %day;

my $strptime = <<'ESQ';
 my %month = map { lc $_ } %$mon_ref;
 my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
 my $monpat = join("|", reverse sort keys %month);
 my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);

 my %ampm = (
    'a' => 0,  # AM
    'p' => 12, # PM
    );

 my($AM, $PM) = (0,12);

sub {

  my $dtstr = lc shift;
  my $merid = 24;

  my($century,$year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);

  $zone = tz_offset(shift) if @_;

  1 while $dtstr =~ s#\([^\(\)]*\)# #o;

  $dtstr =~ s#(\A|\n|\Z)# #sog;

  # ignore day names
  $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
  $dtstr =~ s/(?
  $dtstr =~ s#($daypat)\s*(den\s)?\b# #o;
  # Time: 12:00 or 12:00:00 with optional am/pm

  return unless $dtstr =~ /\S/;

  # ISO compact: YYYYMMDD without delimiter (month and day must be exactly 2 digits)
  if ($dtstr =~ s/\s(\d{4})(\d\d)(\d\d)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\5(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
    ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$2-1,$3,$4,$6,$7,$8);
  }
  # Date with explicit delimiter: YYYY[-:]MM[-:]DD
  elsif ($dtstr =~ s/\s(\d{4})([-:])(\d\d?)\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
    ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
  }

  # default C++ boost timestamp is effectively %Y-%b-%d %H:%M:%S.%f
  # details: https://svn.boost.org/trac/boost/ticket/8839
  if ($dtstr =~ s/\s(\d{4})([-:]?)(\w{3,})\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
    ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$month{$3},$4,$5,$7,$8,$9);
  }

  unless (defined $hh) {
    if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?(z)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
      ($hh,$mm,$ss) = ($1,$2,$4);
      $zone = 0 if $5;
      $merid = $ampm{$6} if $6;
    }

    # Time: 12 am

    elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
      ($hh,$mm,$ss) = ($1,0,0);
      $merid = $ampm{$2};
    }
  }

  if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
    $merid = $ampm{$1};
  }


  unless (defined $year) {
    # Date: 12-June-96 (using - . or /)

    if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
      ($month,$day) = ($month{$3},$1);
      $year = $5 if $5;
    }

    # Date: 12-12-96 (using '-', '.' or '/' )

    elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
      ($month,$day) = ($1 - 1,$3);

      if ($5) {
    $year = $5;
    # Possible match for 1995-01-24 (short mainframe date format);
    ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
    return if length($year) > 2 and $year < 1901;
      }
    }
    elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
      ($month,$day) = ($month{$3},$1);
    }
    elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
      $month = $month{$1};
      if ($2 > 31) { $year = $2 } else { $day = $2 }
    }
    elsif ($dtstr =~ s#($monpat)([\/-])(\d+)[\/-]# #o) {
      ($month,$day) = ($month{$1},$3);
    }

    # Date: 961212 (YYMMDD — only consume if month is in range 1-12)

    elsif ($dtstr =~ /\s(\d\d)(\d\d)(\d\d)\s/o && $2 >= 1 && $2 <= 12) {
      $dtstr =~ s/\s(\d\d)(\d\d)(\d\d)\s/ /;
      ($year,$month,$day) = ($1,$2-1,$3);
    }

    $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;

  }

  # Zone

  $dst = 1 if $dtstr =~ s#\bdst\b##o;

  if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
    $dst = 1 if $2 and $2 eq 'dst';
    $zone = tz_offset($1);
    return unless defined $zone;
  }
  elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
    my $m = defined($4) ? "$2$4" : 0;
    my $h = "$2$3";
    $zone = defined($1) ? tz_offset($1) : 0;
    return unless defined $zone;
    $zone += 60 * ($m + (60 * $h));
  }

  if ($dtstr =~ /\S/) {
    # now for some dumb dates
    if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
      $zone = 0;
    }
    elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
      my $m = defined($4) ? "$2$4" : 0;
      my $h = "$2$3";
      $zone = defined($1) ? tz_offset($1) : 0;
      return unless defined $zone;
      $zone += 60 * ($m + (60 * $h));
    }

    return if $dtstr =~ /\S/o;
  }

  if (defined $hh) {
    if ($hh == 12) {
      $hh = 0 if $merid == $AM;
    }
    elsif ($merid == $PM) {
      $hh += 12;
    }
  }

  if (defined $year && $year >= 100) {
    $century = int($year / 100);
    $year -= 1900;
  }

  $zone += 3600 if defined $zone && $dst;
  $ss += "0.$frac" if $frac;

  # Reject inputs that produced only a timezone with no date/time components.
  # A bare number like '1' or '+0500' gets consumed by the timezone regex,
  # leaving no meaningful date or time information — these are not valid dates.
  return unless defined $hh || defined $mm || defined $ss
             || defined $day || defined $month || defined $year;

  return ($ss,$mm,$hh,$day,$month,$year,$zone,$century);
}
ESQ

our ($day_ref, $mon_ref, $suf_ref, $obj);

sub gen_parser
{
 local($day_ref,$mon_ref,$suf_ref,$obj) = @_;

 if($obj)
  {
   my $obj_strptime = $strptime;
   substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
 shift; # package
ESQ
   my $sub = eval "$obj_strptime" or die $@;
   return $sub;
  }

 eval "$strptime" or die $@;

}

*strptime = gen_parser(\%day,\%month,\@suf);

sub str2time
{
 my $now = @_ > 2 ? splice(@_, 2, 1) : time;
 my @t = strptime(@_);

 return undef
    unless @t;

 my($ss,$mm,$hh,$day,$month,$year,$zone, $century) = @t;
 my @lt  = localtime($now);

 $hh    ||= 0;
 $mm    ||= 0;
 $ss    ||= 0;

 my $frac = $ss - int($ss);
 $ss = int $ss;

 $month = $lt[4]
    unless(defined $month);

 $day  = $lt[3]
    unless(defined $day);

 unless (defined $year) {
   my $is_future = $month > $lt[4]
                || ($month == $lt[4] && $day > $lt[3]);
   $year = $is_future ? ($lt[5] - 1) : $lt[5];
 }

 # we were given a 4 digit year, so let's keep using those
 $year += 1900 if defined $century;

 # Normalize two-digit years to 4-digit before passing to Time::Local.
 # Time::Local's own windowing varies across versions, so we do it ourselves.
 # Convention: 69-99 -> 1969-1999, 0-68 -> 2000-2068 (POSIX strptime behavior).
 # Note: first-century dates (years 1-99 AD) are not representable through
 # str2time — same limitation as POSIX strptime.
 $year += ($year >= 69 ? 1900 : 2000) if $year < 100;

 return undef
    unless($month <= 11 && $day >= 1 && $day <= 31
        && $hh <= 23 && $mm <= 59 && $ss <= 59);

 my $result;

 if (defined $zone) {
   $result = eval {
     local $SIG{__DIE__} = sub {}; # Ick!
     timegm($ss,$mm,$hh,$day,$month,$year);
   };
   return undef
     if !defined $result
        or $result == -1
           && join("",$ss,$mm,$hh,$day,$month,$year)
                ne "595923311169";
   # Detect integer overflow: post-1970 dates must produce a non-negative epoch
   return undef if $result < 0 && $year >= 1970;
   $result -= $zone;
 }
 else {
   $result = eval {
     local $SIG{__DIE__} = sub {}; # Ick!
     timelocal($ss,$mm,$hh,$day,$month,$year);
   };
   return undef
     if !defined $result
        or $result == -1
           && join("",$ss,$mm,$hh,$day,$month,$year)
                ne join("",(localtime(-1))[0..5]);
   # Detect integer overflow: post-1970 dates must produce a non-negative epoch
   # Use 1971 to avoid false positives from timezone offsets near epoch 0
   return undef if $result < 0 && $year >= 1971;
 }

 return $result + $frac;
}

1;

__END__