view release on metacpan or  search on metacpan

lib/Date/Extract.pm  view on Meta::CPAN

package Date::Extract;
use strict;
use warnings;
use DateTime::Format::Natural;
use List::Util 'reduce';
use parent 'Class::Data::Inheritable';

our $VERSION = '0.05.01'; # VERSION
our $DATE = '2014-06-09'; # DATE

__PACKAGE__->mk_classdata($_) for qw/scalar_downgrade handlers regex/;

sub _croak {
    require Carp;
    Carp::croak @_;
}

sub new {
    my $class = shift;
    my %args = (
        format => 'DateTime',
        returns => 'first',
        prefers => 'nearest',
        time_zone => 'floating',
        @_,
    );

    if ($args{format} ne 'DateTime'
     && $args{format} ne 'verbatim'
     && $args{format} ne 'epoch'
     && $args{format} ne 'combined') {
        _croak "Invalid `format` passed to constructor: expected `DateTime', `verbatim', `epoch', `combined'.";
    }

    if ($args{returns} ne 'first'
     && $args{returns} ne 'last'
     && $args{returns} ne 'earliest'
     && $args{returns} ne 'latest'
     && $args{returns} ne 'all'
     && $args{returns} ne 'all_cron') {
        _croak "Invalid `returns` passed to constructor: expected `first', `last', `earliest', `latest', `all', or `all_cron'.";
    }

    if ($args{prefers} ne 'nearest'
     && $args{prefers} ne 'past'
     && $args{prefers} ne 'future') {
        _croak "Invalid `prefers` passed to constructor: expected `nearest', `past', or `future'.";
    }

    my $self = bless \%args, ref($class) || $class;

    return $self;
}

# This method will combine the arguments of parser->new and extract. Modify the
# "to" hash directly.

sub _combine_args {
    shift;

    my $from = shift;
    my $to = shift;

    $to->{format}    ||= $from->{format};
    $to->{prefers}   ||= $from->{prefers};
    $to->{returns}   ||= $from->{returns};
    $to->{time_zone} ||= $from->{time_zone};
}

sub extract {
    my $self = shift;
    my $text = shift;
    my %args = @_;

    # using extract as a class method
    $self = $self->new
        if !ref($self);

    # combine the arguments of parser->new and this
    $self->_combine_args($self, \%args);

    # when in scalar context, downgrade
    $args{returns} = $self->_downgrade($args{returns})
        unless wantarray;

    # do the work
    my @ret = $self->_extract($text, %args);

    # munge the output to match the desired return type
    return $self->_handle($args{returns}, @ret);
}

# build the giant regex used for parsing. it has to be a single regex, so that
# the order of matches is correct.
sub _build_regex {
    my $self = shift;

    my $relative          = '(?:today|tomorrow|yesterday)';

    my $long_weekday      = '(?:Monday|Tuesday|Wednesday|Thursday|Friday|Saturday|Sunday)';
    my $short_weekday     = '(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)';
    my $weekday           = "(?:$long_weekday|$short_weekday)";

    my $relative_weekday  = "(?:(?:next|previous|last)\\s*$weekday)";

    my $long_month        = '(?:January|February|March|April|May|June|July|August|September|October|November|December)';
    my $short_month       = '(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)';
    my $month             = "(?:$long_month|$short_month)";

    # 1 - 31