#!/nix/store/ww69rb7srifikvilg39q4v8n9h1zcssf-perl-5.38.2/bin/perl -I/nix/store/ww69rb7srifikvilg39q4v8n9h1zcssf-perl-5.38.2/lib/perl5/site_perl -I/nix/store/7cgzxmpibsppq5cgkn1ahybdsjfavd0v-perl5.38.2-Module-Util-1.09/lib/perl5/site_perl -I/nix/store/w8x2x6sfcvknlrv4940z3p1n03hgyilf-perl5.38.2-Test-MockTime-HiRes-0.08/lib/perl5/site_perl -I/nix/store/7r1dx9ivwmx7pqq6pw03wfxz9n36wzj2-perl5.38.2-Test-MockTime-0.17/lib/perl5/site_perl -I/nix/store/a66h1wl7rwgdjxqpr7rcp7qsygp73nm7-perl5.38.2-Module-Build-0.4234/lib/perl5/site_perl -I/nix/store/smqc7vyjlq8x4chmkwpsmq0n2yglkvf3-perl5.38.2-Clone-0.46/lib/perl5/site_perl -I/nix/store/8604rj40k7m73vpc09k593xhgx6fbjcn-perl5.38.2-DateTime-1.59/lib/perl5/site_perl -I/nix/store/g9nrgvzhlzxl0794bxmlpvv6prn0g53p-perl5.38.2-DateTime-Locale-1.39/lib/perl5/site_perl -I/nix/store/ly4xmnnx10s5hrl6y1lbihzwilg06ngi-perl5.38.2-File-ShareDir-1.118/lib/perl5/site_perl -I/nix/store/71n823r7vpwq71xgfqbx6ri2x08252lv-perl5.38.2-Class-Inspector-1.36/lib/perl5/site_perl -I/nix/store/2q0zriv6pcpx896zcm68fx9m6rkcr5xm-perl5.38.2-Params-ValidationCompiler-0.31/lib/perl5/site_perl -I/nix/store/fm74nzrj1q7gr691m0z2ilp79vqx2p1q-perl5.38.2-Eval-Closure-0.14/lib/perl5/site_perl -I/nix/store/7hkp90cy2c7ji7j0wva9w59kp1aj8kqb-perl5.38.2-Exception-Class-1.45/lib/perl5/site_perl -I/nix/store/nax9351hy8xcpsmdvl2dr23l19a1rfx3-perl5.38.2-Class-Data-Inheritable-0.09/lib/perl5/site_perl -I/nix/store/0d8160kgpwy3hkzgd0dja44j4d0jqaxx-perl5.38.2-Devel-StackTrace-2.04/lib/perl5/site_perl -I/nix/store/g4bivfz6h4znd0lv651m7a3rskkhb731-perl5.38.2-Specio-0.48/lib/perl5/site_perl -I/nix/store/brklryclwzrhr7xfbgxrvl1akn9aq0hy-perl5.38.2-MRO-Compat-0.15/lib/perl5/site_perl -I/nix/store/ckx6kds6x86vsb90ck69xd1033dxc1xd-perl5.38.2-Module-Runtime-0.016/lib/perl5/site_perl -I/nix/store/25v0v6r0swabiqw3imjvwjf6bz53j67k-perl5.38.2-Role-Tiny-2.002004/lib/perl5/site_perl -I/nix/store/i2ba8s01blyl5r3k0hm3z6ihrasdv2fc-perl5.38.2-Sub-Quote-2.006008/lib/perl5/site_perl -I/nix/store/k9bj7v2acm0ksvsyv0j79pyv338fpdb6-perl5.38.2-Try-Tiny-0.31/lib/perl5/site_perl -I/nix/store/j3cjf2x35lfafh4syf5a7k33yvpygg8v-perl5.38.2-namespace-autoclean-0.29/lib/perl5/site_perl -I/nix/store/aq8nf8jjlpyx67y9bd0i4acx4sqrnrwl-perl5.38.2-Sub-Identify-0.14/lib/perl5/site_perl -I/nix/store/zn3s3frnixy2ljxnkwji3a6i53zhbwlk-perl5.38.2-namespace-clean-0.27/lib/perl5/site_perl -I/nix/store/ckbnlgj989m24yp7cmk31173qvnjjiyn-perl5.38.2-B-Hooks-EndOfScope-0.26/lib/perl5/site_perl -I/nix/store/9ssbmqcmw4ix0xks6x3ccxmf4i52azr9-perl5.38.2-Module-Implementation-0.09/lib/perl5/site_perl -I/nix/store/iijlyi71nqadvsk959nx9pjqrd34b8vb-perl5.38.2-Sub-Exporter-Progressive-0.001013/lib/perl5/site_perl -I/nix/store/hs9n6idzxd1cz22hizicasljq46hsy36-perl5.38.2-Package-Stash-0.40/lib/perl5/site_perl -I/nix/store/dkfk5rb2wl6bldgghq99nfax9wvfhp00-perl5.38.2-Dist-CheckConflicts-0.11/lib/perl5/site_perl -I/nix/store/pw41zcq5ly6rz9yad88smykhpmpv0zf3-perl5.38.2-DateTime-TimeZone-2.60/lib/perl5/site_perl -I/nix/store/6fgg2a43ck0rf34dnml140257rswfkj5-perl5.38.2-Class-Singleton-1.6/lib/perl5/site_perl -I/nix/store/69d63p6wykf9jr169yxn0igr1yv4wdf8-perl5.38.2-DateTime-HiRes-0.04/lib/perl5/site_perl -I/nix/store/249l42y78hpvwx85rr4vdyjrj42827m0-perl5.38.2-List-MoreUtils-0.430/lib/perl5/site_perl -I/nix/store/bcl44s7li85slqa9aj4hvbnyj8cb4b2p-perl5.38.2-Exporter-Tiny-1.006002/lib/perl5/site_perl -I/nix/store/qwvdypabxn8jc4cb2x7h94jwxdgmf6yw-perl5.38.2-List-MoreUtils-XS-0.430/lib/perl5/site_perl -I/nix/store/ysk0s0cq6c2gm9jl7ns78v22ql9z40c8-perl5.38.2-Params-Validate-1.31/lib/perl5/site_perl -I/nix/store/hz53w2axv9260q5ffwjm99jchacx628q-perl5.38.2-boolean-0.46/lib/perl5/site_perl -I/nix/store/ldwlkmrf7cknzhar2m1l1zjhnm4352mx-perl5.38.2-DateTime-Format-Natural-1.18/lib/perl5/site_perl

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

use DateTime;
use DateTime::Format::Natural;
use Getopt::Long qw(:config no_auto_abbrev no_ignore_case);
use Term::ReadLine;

use constant LANG_DEFAULT => 'en';

my %args;
my $extract;
my $lang;
my @supported_languages = qw(en);
my $trace;
my %valid_languages = map { $_ => true } @supported_languages;

{
    my $opts = {};
    $opts = parse_switches() if @ARGV;
    set_values($opts);
    process();
}

sub parse_switches
{
    my %opts;
    GetOptions(\%opts, qw(d|datetime=s
                          e|extract
                          f|format=s
                          h|help
                          l|lang=s
                          p|prefer_future
                          P|demand_future
                          s|supported
                          t|time_zone=s
                          T|trace
                          V|version)) or usage();

    usage()     if $opts{h};
    version()   if $opts{V};
    supported() if $opts{s};

    return \%opts;
}

sub set_values
{
    my $opts = shift;

    $extract = $opts->{e} || false;
    $lang    = $opts->{l} || LANG_DEFAULT;
    $trace   = $opts->{T} || false;

    if (exists $opts->{d}) {
        local $_ = $opts->{d};
        my ($got_date, $got_time) = (false) x 2;
        my $ignore = false;
        my %time;
        if (/^\S+? (?:\s+? \S+?)?$/x) {
            if (/^(\d{4}-\d{2}-\d{2})\b/) {
                @time{qw(year month day)} = split /-/, $1;
                $got_date = true;
            }
            if (/\b(\d{2}:\d{2}:\d{2})(?:\.(\d{3}))?$/) {
                @time{qw(hour minute second)} = split /:/, $1;
                $time{nanosecond} = $2 * 1_000_000 if $2; # milli to nano
                $got_time = true;
            }
        }
        if ($got_date || $got_time) {
            my %opts = exists $opts->{t} ? (time_zone => $opts->{t}) : ();
            if (!$got_date) { # time only
                my @units = qw(year month day);
                @time{@units} = map DateTime->now(%opts)->$_, @units;
            }
            eval { $opts->{d} = DateTime->new(%time, %opts) } or $ignore = true;
        }
        else {
            $ignore = true;
        }
        if ($ignore) {
            warn "ignoring invalid datetime string '$opts->{d}'\n";
            delete $opts->{d};
        }
    }

    my %table = (
        d => 'datetime',
        l => 'lang',
        f => 'format',
        p => 'prefer_future',
        P => 'demand_future',
        t => 'time_zone',
    );

    foreach my $opt (keys %$opts) {
        if (exists $table{$opt}) {
            $args{$table{$opt}} = $opts->{$opt};
        }
    }
}

sub usage
{
    print <<"USAGE";
Usage: $0 [switches]
   -d, --datetime=<string>     datetime string
   -e, --extract               extract expressions
   -f, --format=<format>       format of numeric dates
   -h, --help                  this help screen
   -l, --lang=<code>           language code
   -p, --prefer_future         prefer future dates
   -P, --demand_future         demand future dates
   -s, --supported             list of supported languages
   -t, --time_zone=<string>    time zone string
   -T, --trace                 print trace after processing
   -V, --version               print version
USAGE
    exit;
}

sub version
{
    print "  DateTime::Format::Natural $DateTime::Format::Natural::VERSION\n";
    exit;
}

sub supported
{
    print "$_\n" foreach @supported_languages;
    exit;
}

sub process
{
    unless ($valid_languages{lc $lang}) {
        warn "Language [$lang] isn't supported, switching to default [", LANG_DEFAULT, "]\n";
        $lang = $args{lang} = LANG_DEFAULT;
    }

    my $parser = DateTime::Format::Natural->new(%args);

    my $term = Term::ReadLine->new('dateparse');
    my $prompt = 'dateparse> ';

    while (defined(my $input = $term->readline($prompt))) {
        $term->addhistory($input) if $input =~ /\S/;
        last if $input =~ /^(?:q(?:uit)?|exit)$/i;

        if ($input =~ /^(?:\?|help)$/i) {
            print <<'EOT';

Commands
 ?, help                this help screen
 exit, q, quit          leave dateparse
 everything else        input string

EOT
            next;
        }

        my @expressions = $extract ? $parser->extract_datetime($input) : ($input);

        warn "no parsable expressions extracted\n" unless @expressions;

        foreach my $expression (@expressions) {
            print "extracted: $expression\n" if $extract;

            my @dt = $parser->parse_datetime_duration(string => $expression);
            my @traces = $parser->trace;

            if ($parser->success) {
                foreach my $dt (@dt) {
                    print $dt->strftime('%Y-%m-%d %H:%M:%S.%3N'), "\n";
                    if ($trace && @traces) {
                        print shift @traces, "\n";
                    }
                }
            }
            else {
                warn $parser->error, "\n";
            }
        }
    }
}

=head1 NAME

dateparse - frontend to DateTime::Format::Natural

=head1 SYNOPSIS

 Usage: dateparse [switches]
   -d, --datetime=<string>     datetime string *
   -e, --extract               extract expressions
   -f, --format=<format>       format of numeric dates
   -h, --help                  this help screen
   -l, --lang=<code>           language code
   -p, --prefer_future         prefer future dates
   -P, --demand_future         demand future dates
   -s, --supported             list of supported languages
   -t, --time_zone=<string>    time zone string
   -T, --trace                 print trace after processing
   -V, --version               print version

* The date must conform to YYYY-MM-DD and the time to hh:mm:ss(.ms).
Valid datetime strings consist of either date, date/time or time.

=head1 AUTHOR

Steven Schubiger <schubiger@cpan.org>

=head1 LICENSE

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

See L<http://dev.perl.org/licenses/>

=cut
