view release on metacpan or  search on metacpan

lib/DateTime/Format/Natural.pm  view on Meta::CPAN

{
    my ($error) = @_;
    chomp $error;
    croak $error;
},
    stack_skip => 2,
);

sub new
{
    my $class = shift;

    my $self = bless {}, ref($class) || $class;

    $self->_init_check(@_);
    $self->_init(@_);

    return $self;
}

sub _init
{
    my $self = shift;
    my %opts = @_;

    my %presets = (
        lang           => 'en',
        format         => 'd/m/y',
        demand_future  =>  false,
        prefer_future  =>  false,
        time_zone      => 'floating',
        calendar_class =>  undef,
    );
    foreach my $opt (keys %presets) {
        $self->{ucfirst $opt} = $presets{$opt};
    }
    foreach my $opt (keys %opts) {
        if (defined $opts{$opt}) {
            $self->{ucfirst $opt} = $opts{$opt};
        }
    }
    $self->{Daytime} = $opts{daytime} || {};

    my $mod = join '::', (__PACKAGE__, 'Lang', uc $self->{Lang});
    eval "require $mod; 1" or die $@;

    $self->{data} = $mod->__new();
    $self->{grammar_class} = $mod;

    $self->{mode} = '';
}

sub _init_check
{
    my $self = shift;

    validate(@_, {
        calendar_class => {
            type => SCALAR | UNDEF,
            optional => true,
            callbacks => {
                'calendar class exists' => sub
                {
                    my $class = shift;
                    return true unless defined $class;
                    return $class eq 'DateTime::Calendar::Julian' && eval "require $class; 1";
                },
            },
        },
        demand_future => {
            # SCALARREF due to boolean.pm's implementation
            type => BOOLEAN | SCALARREF,
            optional => true,
            callbacks => {
                'mutually exclusive' => sub
                {
                    return true unless exists $_[1]->{prefer_future};
                    die "prefer_future provided\n";
                },
            },
        },
        lang => {
            type => SCALAR,
            optional => true,
            regex => qr!^(?:en)$!i,
        },
        format => {
            type => SCALAR,
            optional => true,
            regex => qr!^(?:
                           (?: (?: [dmy]{1,4}[-./] ){2}[dmy]{1,4} )
                             |
                           (?: [dm]{1,2}/[dm]{1,2} )
                         )$!ix,
        },
        prefer_future => {
            # SCALARREF due to boolean.pm's implementation
            type => BOOLEAN | SCALARREF,
            optional => true,
            callbacks => {
                'mutually exclusive' => sub
                {
                    return true unless exists $_[1]->{demand_future};
                    die "demand_future provided\n";
                },
            },
        },
        time_zone => {
            type => SCALAR | OBJECT,
            optional => true,
            callbacks => {
                'valid timezone' => sub
                {
                    my $val = shift;
                    if (blessed($val)) {
                        return $val->isa('DateTime::TimeZone');
                    }
                    else {
                        eval { DateTime::TimeZone->new(name => $val) };
                        return !$@;
                    }
                }
            },
        },
        daytime => {
            type => HASHREF,
            optional => true,
            callbacks => {
                'valid daytime' => sub
                {
                    my $href = shift;
                    my %daytimes = map { $_ => true } qw(morning afternoon evening);
                    if (any { !$daytimes{$_} } keys %$href) {
                        die "spelling of daytime\n";
                    }
                    elsif (any { !defined $href->{$_} } keys %$href) {
                        die "undefined hour\n";
                    }
                    elsif (any { $href->{$_} !~ /^\d{1,2}$/ } keys %$href) {
                        die "not a valid number\n";
                    }
                    elsif (any { $href->{$_} < 0 || $href->{$_} > 23 } keys %$href) {
                        die "hour out of range\n";
                    }
                    else {
                        return true;
                    }
                }
            },
        },
        datetime => {
            type => OBJECT,
            optional => true,
            callbacks => {
                'valid object' => sub
                {
                    my $obj = shift;
                    blessed($obj) && $obj->isa('DateTime');
                }
            },
        },
    });
}

sub _init_vars
{
    my $self = shift;

    delete @$self{qw(keyword modified postprocess)};
}

sub parse_datetime
{
    my $self = shift;

    $self->_parse_init(@_);

    $self->{input_string} = $self->{date_string};

    $self->{mode} = 'parse';

    my $date_string = $self->{date_string};

    $self->_rewrite(\$date_string);

    my ($formatted) = $date_string =~ $self->{data}->__regexes('format');
    my %count = $self->_count_separators($formatted);

    $self->{tokens} = [];
    $self->{traces} = [];

    if ($self->_check_formatted('ymd', \%count)) {
        my $dt = $self->_parse_formatted_ymd($date_string, \%count);
        return $dt if blessed($dt);
    }
    elsif ($self->_check_formatted('md', \%count)) {
        my $dt = $self->_parse_formatted_md($date_string);
        return $dt if blessed($dt);

        if ($self->{Prefer_future} || $self->{Demand_future}) {
            $self->_advance_future('md');
        }
    }
    elsif ($date_string =~ /^(\d{4}(?:-\d{2}){0,2})T(\d{2}(?::\d{2}){0,2})(?:[.,](\d+))?(Z|[+-]\d{2}(?::?\d{2})?)?$/) {
        my ($date, $time, $fractional, $tz) = ($1, $2, $3, $4);
        my %args;

        if (defined $tz) {
            if ($tz eq 'Z') {
                $self->{datetime}->set_time_zone('UTC');
            } elsif ($tz =~ /^([+-])(\d{2})$/) {
                $tz = "$1$2:00";
            } else {
                $tz =~ s/^([+-])(\d{2}):?(\d{2})$/$1$2:$3/;