File Coverage

blib/lib/DateTimeX/Easy.pm

Criterion	Covered	Total	%
statement	14	16	87.5
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	20	22	90.9

package DateTimeX::Easy;
BEGIN {
  $DateTimeX::Easy::VERSION = '0.089';
}
# ABSTRACT: Parse a date/time string using the best method available

use warnings;
use strict;

use constant DEBUG => 0;


use base qw/Exporter/;
our @EXPORT_OK = qw/datetime parse parse_datetime parse_date new_datetime new_date date/;

use DateTime;
use DateTime::Format::Natural;
use DateTime::Format::Flexible;
# use DateTime::Format::DateParse; # Unfortunately, not as useful to use because of that default "local" time zone business.
use DateTimeX::Easy::DateParse; # Using this instead, hrm.
use Scalar::Util qw/blessed/;
use Carp;

my $have_ICal;
eval {
    require DateTime::Format::ICal;
    $have_ICal = 1;
};

my $have_DateManip;
eval {
    require DateTime::Format::DateManip;
    $have_DateManip = 1;
};
my $natural_parser = DateTime::Format::Natural->new;

my %_truncate_range = qw/
    month year
    day month
    hour day
    minute hour
    second minute
    nanosecond second
/;
my %_delta_range = (
    month => [qw/years months/],
    day => [qw/months days/],
    hour => [qw/days hours/],
    minute => [qw/hours minutes/],
    second => [qw/minutes seconds/],
);
my %_first_or_last = qw/
    first       first
    last        last
    begin       first
    beginning   first
    start       first
    end         last
    ending      last
/;

my @_parser_order = qw/
    Flexible
    DateParse
    Natural
/;
unshift @_parser_order, qw/ICal/ if $have_ICal;
push @_parser_order, qw/DateManip/ if $have_DateManip;
my %_parser_source = (
    ICal => sub {
        return DateTime::Format::ICal->parse_datetime(shift);
    },

    DateParse => sub {
        return DateTimeX::Easy::DateParse->parse_datetime(shift);
    },

    Natural => sub {
        local $SIG{__WARN__} = sub {}; # Make sure ::Natural/Date::Calc stay quiet... don't really like this, oh well...
        my $dt = $natural_parser->parse_datetime(shift);
        return unless $natural_parser->success;
        return $dt;
    },

    Flexible => sub {
        my $parse = shift;
        my $time_zone;
        # First, try to extract out any timezone information
        {
            ##################################################
            # 2008-09-16 13:23:57 Eastern Daylight (?:Time)? #
            ##################################################
            if ($parse =~ s/\s+(?:(Eastern|Central|Mountain|Pacific)\s+(?:Daylight|Standard)(?:\s+Time)?).*$//) {
                $time_zone = "US/$1";
            }
            ##################################
            # 2008-09-16 13:23:57 US/Eastern #
            ##################################
            elsif ($parse =~ s/\s+([A-Za-z][A-Za-z0-9\/\._]*)\s*$//) { # Look for a timezone-like string at the end of $parse
                $time_zone = $1;
                $parse = "$parse $time_zone" and undef $time_zone if $time_zone && $time_zone =~ m/^[ap]\.?m\.?$/i; # Put back AM/PM if we accidentally slurped it out
            }
            #########################################################
            # 2008-09-16 13:23:57 Eastern Daylight Time (GMT+05:00) #
            #########################################################
            elsif ($parse =~ s/(?:\s+[A-Z]\w+)*\s+\(?(?:GMT|UTC)?([-+]\d{2}:\d{2})\)?\s*$//) {
                $time_zone = $1;
            }
# Flexible can't seem to parse (GMT+0:500)
#            elsif ($parse =~ s/(?:\s+[A-Z]\w+)*(\s+\(GMT[-+]\d{2}:\d{2}\)\s*)$//) {
#                $parse = "$parse $1";
#            }
            #############################
            # 2008-09-16 13:23:57 +0500 #
            #############################
            elsif ($parse =~ s/\s+([-+]\d{3,})\s*$//) {
                $time_zone = $1;
            }
        }
        return unless my $dt = DateTime::Format::Flexible->build($parse);
        if ($time_zone) {
            $dt->set_time_zone("floating");
            $dt->set_time_zone($time_zone);
        }
        return $dt;
    },

    DateManip => sub {
        return DateTime::Format::DateManip->parse_datetime(shift);
    },
);

sub new {
    shift if $_[0] && $_[0] eq __PACKAGE__;

    my $parse;
    $parse = shift if @_ % 2;

    my %in = @_;
    $parse = delete $in{parse} if exists $in{parse};
    my $truncate = delete $in{truncate};
    my $soft_time_zone_conversion = delete $in{soft_time_zone_conversion};
    my $time_zone_if_floating = delete $in{default_time_zone};
    $time_zone_if_floating = delete $in{time_zone_if_floating} if exists $in{time_zone_if_floating};
    my $parser_order = delete $in{parser_order};
    my $parser_exclude = delete $in{parser_exclude};
    my $ambiguous = 1;
    $ambiguous = delete $in{ambiguous} if exists $in{ambiguous};

    my ($time_zone);
    $time_zone = delete $in{tz} if exists $in{tz};
    $time_zone = delete $in{timezone} if exists $in{timezone};
    $time_zone = delete $in{time_zone} if exists $in{time_zone}; # "time_zone" takes precedence over "timezone"

    my @delta;

    my $original_parse = $parse;
    my $parse_dt;
    if ($parse) {
        if (blessed $parse && $parse->isa("DateTime")) { # We have a DateTime object as $parse
            $parse_dt = $parse;
        }
        else {

            if (1) {
                my $got_ambiguous;
                my ($last_delta);
                while ($parse =~ s/^\s*(start|first|last|(?:begin|end)(?:ning)?)\s+(year|month|day|hour|minute|second)\s+of\s+//i) {
                    my $first_or_last = $1;
                    $first_or_last = $_first_or_last{lc $first_or_last};
                    my $period = $2;
                    $last_delta->{add} = [ "${period}s" => 1 ] if $last_delta;
                    push @delta, $last_delta = my $delta = { period => $period };
                    if ($first_or_last ne "first") {
                        $delta->{last} = 1;
                        $delta->{subtract} = [ "${period}s" => 1 ];
                    }
                    else {
                        $delta->{first} = 1;
                    }
                }
                my $last_parse = $parse;
                my $period;
                if ($parse =~ s/^\s*(start|this|next|first|last|(?:begin|end)(?:ning)?)\s+(year|month|day|hour|minute|second)(?:\s+of\s+)?//) {
                    $period = $2;
                    $last_delta->{add} = [ "${period}s" => 1 ] if $last_delta && $last_delta->{last};
                    push @delta, { truncate => $period};
                    $parse = $last_parse unless $parse;
                }
                elsif ($parse =~ s/^\s*(year|month|day|hour|minute|second)\s+of\s+//i) {
                    $period = $1;
                    $last_delta->{add} = [ "${period}s" => 1 ] if $last_delta && $last_delta->{last};
                    push @delta, { truncate => $period };
                }
                elsif (@delta) {
                    $got_ambiguous = 1;
                    $period = $last_delta->{period};
                    my $truncate = $_truncate_range{$period};
                    push @delta, my $delta = { truncate => $truncate };
                    my $delta_range = $_delta_range{$period};
                    if ($delta_range) {
                        my ($add, $subtract) = @$delta_range;
                        if ($last_delta->{last}) {
                            $last_delta->{add} = [ "${add}" => 1 ];
                        }
                    }
                }

                croak "Can't parse \"$original_parse\" since it's too ambiguous" if $got_ambiguous && ! $ambiguous;
            }

            my @parser_order = $parser_order ? (ref $parser_order eq "ARRAY" ? @$parser_order : ($parser_order)) : @_parser_order;
            my (%parser_exclude);
            %parser_exclude = map { $_ => 1 } (ref $parser_exclude eq "ARRAY" ? @$parser_exclude : ($parser_exclude)) if $parser_exclude;
            my %parser_source = %_parser_source;
            if (DEBUG) {
                warn "Parse $parse\n";
            }
            # TODO Kinda hackish
            if ($parse =~ m/^[1-9]\d{3}$/) { # If it's a four digit year... yeah, arbitrary
                $parse_dt = DateTime->new(year => $parse);
            }
            while (! $parse_dt && @parser_order) {
                my $parser = shift @parser_order;
                next if $parser_exclude{$parser};
                # warn "Try $parser:\n" if DEBUG;
                my $parser_code = $parser_source{$parser};
                eval {
                    $parse_dt = $parser_code->($parse);
                };
                if (DEBUG) {
                    if ($@) {
                        warn "FAIL $parser: $@\n";
                    }
                    elsif ($parse_dt) {
                        warn "PASS $parser: $parse_dt\n";
                    }
                    else {
                        warn "FAIL $parser\n";
                    }
                }
                undef $parse_dt if $@;
            }
        }
        return unless $parse_dt;
    }

    my %DateTime;
    $DateTime{time_zone} = "floating";
    if ($parse_dt) {
        $DateTime{$_} = $parse_dt->$_ for qw/year month day hour minute second nanosecond time_zone/;
    }
    @DateTime{keys %in} = values %in;

    return unless my $dt = DateTime->new(%DateTime);

    if ($time_zone) {
        if ($soft_time_zone_conversion) {
            $dt->set_time_zone("floating");
        }
        $dt->set_time_zone($time_zone);
    }
    elsif ($time_zone_if_floating && $dt->time_zone->is_floating) {
        $dt->set_time_zone($time_zone_if_floating);
    }

    if ($truncate) {
        $truncate = $truncate->[1] if ref $truncate eq "ARRAY";
        $truncate = (values %$truncate)[0] if ref $truncate eq "HASH";
        $dt->truncate(to => $truncate);
    }
    elsif (@delta) {
        if (DEBUG) {
            require YAML;
            warn "$original_parse => $parse => $dt";
        }
        for my $delta (reverse @delta) {
            warn YAML::Dump($delta) if DEBUG;
            if ($delta->{truncate}) {
                $dt->truncate(to => $delta->{truncate});
            }
            else {
                $dt->add(@{ $delta->{add} }) if $delta->{add};
                $dt->subtract(@{ $delta->{subtract} }) if $delta->{subtract};
            }
        }
    }

    return $dt;
}
*parse = \&new;
*parse_date = \&new;
*parse_datetime = \&new;
*date = \&new;
*datetime = \&new;
*new_date = \&new;
*new_datetime = \&new;

1;

__END__