<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package DateTime::Format::Natural::Expand;

use strict;
use warnings;
use boolean qw(true false);

use Clone qw(clone);
use DateTime::Format::Natural::Helpers qw(%flag);

our $VERSION = '0.03';

my %data = (
    time =&gt; {
        4 =&gt; {},
        5 =&gt; '_time',
        6 =&gt; { truncate_to =&gt; [q(hour_minute)] },
    },
    time_min =&gt; {
        4 =&gt; {},
        5 =&gt; '_time',
        6 =&gt; { truncate_to =&gt; [q(minute)] },
    },
    time_am =&gt; {
        2 =&gt; 'meridiem',
        3 =&gt; $flag{time_am},
        4 =&gt; {},
        5 =&gt; '_at',
        6 =&gt; { truncate_to =&gt; [q(hour_minute)] },
    },
    time_pm =&gt; {
        2 =&gt; 'meridiem',
        3 =&gt; $flag{time_pm},
        4 =&gt; {},
        5 =&gt; '_at',
        6 =&gt; { truncate_to =&gt; [q(hour_minute)] },
    },
);

my %expand_prefix = (
    date_literal_variant        =&gt; [ qw(     time_min time_am time_pm) ],
    week_variant                =&gt; [ qw(     time_min time_am time_pm) ],
    month_variant               =&gt; [ qw(     time_min time_am time_pm) ],
    year_variant                =&gt; [ qw(     time_min time_am time_pm) ],
    weekday_variant_week        =&gt; [ qw(time          time_am time_pm) ],
    variant_week_weekday        =&gt; [ qw(time          time_am time_pm) ],
    final_weekday_in_month      =&gt; [ qw(time          time_am time_pm) ],
    month_day                   =&gt; [ qw(     time_min time_am time_pm) ],
    day_month_variant_year      =&gt; [ qw(     time_min time_am time_pm) ],
    day_month_year_ago          =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday               =&gt; [ qw(     time_min time_am time_pm) ],
    count_yearday               =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_from_now      =&gt; [ qw(     time_min time_am time_pm) ],
    count_day_variant_week      =&gt; [ qw(     time_min time_am time_pm) ],
    count_day_variant_month     =&gt; [ qw(     time_min time_am time_pm) ],
    count_month_variant_year    =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_variant_month =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_in_month      =&gt; [ qw(     time_min time_am time_pm) ],
    count_yearday_variant_year  =&gt; [ qw(     time_min time_am time_pm) ],
);
my %expand_suffix = (
    date_literal_variant        =&gt; [ qw(     time_min time_am time_pm) ],
    week_variant                =&gt; [ qw(     time_min time_am time_pm) ],
    month_variant               =&gt; [ qw(     time_min time_am time_pm) ],
    year_variant                =&gt; [ qw(     time_min time_am time_pm) ],
    weekday_variant_week        =&gt; [ qw(time          time_am time_pm) ],
    variant_week_weekday        =&gt; [ qw(time          time_am time_pm) ],
    final_weekday_in_month      =&gt; [ qw(time          time_am time_pm) ],
    day_month_variant_year      =&gt; [ qw(     time_min time_am time_pm) ],
    day_month_year_ago          =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday               =&gt; [ qw(     time_min time_am time_pm) ],
    count_yearday               =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_from_now      =&gt; [ qw(     time_min time_am time_pm) ],
    count_day_variant_week      =&gt; [ qw(     time_min time_am time_pm) ],
    count_day_variant_month     =&gt; [ qw(     time_min time_am time_pm) ],
    count_month_variant_year    =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_variant_month =&gt; [ qw(     time_min time_am time_pm) ],
    count_weekday_in_month      =&gt; [ qw(     time_min time_am time_pm) ],
    count_yearday_variant_year  =&gt; [ qw(     time_min time_am time_pm) ],
);

my $save = sub
{
    my ($type, $target, @values) = @_;

    if ($type eq 'prefix') {
        unshift @$target, @values;
    }
    elsif ($type eq 'suffix') {
        push @$target, @values;
    }
};

sub _expand_for
{
    my $self = shift;
    my ($keyword) = @_;

    return (exists $expand_prefix{$keyword} || exists $expand_suffix{$keyword}) ? true : false;
}

sub _expand
{
    my $self = shift;
    my ($keyword, $types_entry, $grammar) = @_;

    my %expand = (
        prefix =&gt; \%expand_prefix,
        suffix =&gt; \%expand_suffix,
    );

    my (@expandable, @expansions);

    push @expandable, 'prefix' if exists $expand_prefix{$keyword};
    push @expandable, 'suffix' if exists $expand_suffix{$keyword};

    foreach my $type (@expandable) {
        my @elements = @{$expand{$type}-&gt;{$keyword}};

        foreach my $element (@elements) {
           foreach my $entry (@$grammar) {
                my $types = clone($types_entry);

                $save-&gt;($type, $types, 'REGEXP');

                my $new = clone($entry);

                if ($type eq 'prefix') {
                    my %definition;
                    while (my ($pos, $def) = each %{$new-&gt;[0]}) {
                        $definition{$pos + 1} = $def;
                    }
                    %{$new-&gt;[0]} = %definition;

                    my @indexes;
                    foreach my $aref (@{$new-&gt;[1]}) {
                        my @tmp = map $_ + 1, @$aref;
                        push @indexes, [ @tmp ];
                    }
                    @{$new-&gt;[1]} = @indexes;

                    my @flags;
                    foreach my $aref (@{$new-&gt;[3]}) {
                        my @tmp;
                        foreach my $value (@$aref) {
                            if (ref $value eq 'HASH') {
                                my %hash;
                                while (my ($key, $val) = each %$value) {
                                    $key++ if $key =~ /^\d+$/;
                                    $hash{$key} = $val;
                                }
                                push @tmp, { %hash };
                            }
                            else {
                                push @tmp, $value + 1;
                            }
                        }
                        push @flags, [ @tmp ];
                    }
                    @{$new-&gt;[3]} = @flags;
                }

                my %indexes = (
                    prefix =&gt; 0,
                    suffix =&gt; scalar keys %{$new-&gt;[0]},
                );

                my $i = $indexes{$type};

                $new-&gt;[0]-&gt;{$i} = $self-&gt;{data}-&gt;__RE($element);

                if (exists $data{$element}-&gt;{2}) {
                    $save-&gt;($type, $new-&gt;[1], [ $i ]);
                    $save-&gt;($type, $new-&gt;[2], $self-&gt;{data}-&gt;__extended_checks($data{$element}-&gt;{2}));
                }

                push @{$new-&gt;[3]}, exists $data{$element}-&gt;{3} ? [ { $i =&gt; [ $data{$element}-&gt;{3} ] } ] : [ $i ];

                push @{$new-&gt;[4]}, $data{$element}-&gt;{4};
                push @{$new-&gt;[5]}, $data{$element}-&gt;{5};

                foreach my $key (keys %{$data{$element}-&gt;{6}}) {
                    push @{$new-&gt;[6]-&gt;{$key}}, @{$data{$element}-&gt;{6}-&gt;{$key}};
                }

                push @expansions, [ $types, $new ];
            }
        }
    }

    return @expansions;
}

1;
__END__

=head1 NAME

DateTime::Format::Natural::Expand - Expand grammar at runtime

=head1 SYNOPSIS

 Please see the DateTime::Format::Natural documentation.

=head1 DESCRIPTION

C&lt;DateTime::Format::Natural::Expand&gt; dynamically expands the grammar
at runtime in order to allow for additional time to be parsed.

=head1 SEE ALSO

L&lt;DateTime::Format::Natural&gt;

=head1 AUTHOR

Steven Schubiger &lt;schubiger@cpan.org&gt;

=head1 LICENSE

This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.

See L&lt;http://dev.perl.org/licenses/&gt;

=cut
</pre></body></html>