The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl
#Copyright 2007 Arthur S Goldstein
use Test::More tests => 10;
BEGIN { use_ok('Parse::Stallion') };
use Time::Local;
#use Data::Dumper;

my %rule;
$rule{start_date} = AND(
  'parsed_date', 'end_of_string',
  EVALUATION (sub {
#use Data::Dumper; print STDERR "params to start date are ".Dumper(\@_)."\n";
    my $seconds_since_epoch = $_[0]->{parsed_date};
    my ($seconds, $minutes, $hour, $mday, $month, $year) =
     gmtime($seconds_since_epoch);
    $month++;  #Have January be 01 instead of 00.
    if ($month < 10) { $month = '0'.$month;};
    if ($mday < 10) { $mday = '0'.$mday;};
    if ($seconds < 10) { $seconds = '0'.$seconds;};
    if ($minutes < 10) { $minutes = '0'.$minutes;};
    if ($hour < 10) { $hour = '0'.$hour;};
    return (1900+$year).$month.$mday.$hour.$minutes.$seconds;
  }
));
$rule{parsed_date} = OR(
  'date', 'date_operation')
;
$rule{date_operation} = OR(
  'add_time', 'subtract_time')
;
$rule{add_time} = AND(
  'date', 'plus', 'time',
  E(sub {return $_[0]->{date} + $_[0]->{time}}))
;
$rule{subtract_time} = A(
  'date', 'minus', 'time',
  E(sub {
#use Data::Dumper; print STDERR 'params to subtract time are '.Dumper(\@_)."\n";
   return $_[0]->{date} - $_[0]->{time}}))
;
$rule{date} = OR(
  'standard_date', 'special_date')
;
$rule{end_of_string} = LEAF(
  qr/\z/
);
$rule{plus} = LEAF(
  qr/\s*\+\s*/
);
$rule{minus} = LEAF(
  qr/\s*\-\s*/
);
$rule{standard_date} = LEAF(
  qr(\d+\/\d+\/\d+),
  E(sub {my $date = $_[0];
#use Data::Dumper; print STDERR 'params to standard date are '.Dumper(\@_)."\n";
    $date =~ /(\d+)\/(\d+)\/(\d+)/;
    my $month = $1 -1;
    my $mday = $2;
    my $year = $3;
    return timegm(0,0,0,$mday, $month, $year);
  },
));
$rule{special_date} = LEAF(
  qr/now/i,
  E(sub {return timegm(24,40,0,5, 7, 2007);}
));
$rule{time} = OR(
  'just_time', 'just_time_plus_list', 'just_time_minus_list')
;
$rule{just_time_plus_list} = AND(
  'just_time', 'plus', 'time',
  E(sub {return $_[0]->{just_time} + $_[0]->{time}})
);
$rule{just_time_minus_list} = AND(
  'just_time', 'minus', 'time',
  E(sub {return $_[0]->{just_time} - $_[0]->{time}})
);
$rule{just_time} = LEAF(
  qr(\d+\s*[hdms])i,
  E(sub {
#use Data::Dumper; print STDERR 'params to just time are '.Dumper(\@_)."\n";
    my $to_match = $_[0];
    $to_match =~ /(\d+)\s*([hdms])/i;
    my $number = $1;
    my $unit = $2;
    if (lc $unit eq 'h') {
      return $1 * 60 * 60;
    }
    if (lc $unit eq 'd') {
      return $1 * 24 * 60 * 60;
    }
    if (lc $unit eq 's') {
      return $1;
    }
    if (lc $unit eq 'm') {
      return $1 * 60;
    }
  })
);

my $date_parser = new Parse::Stallion(
  \%rule,
  {start_rule => 'start_date'});

my $parsed_tree;
my $result =
 $date_parser->parse_and_evaluate("now");
print "Result is $result\n";

SKIP: {
skip ('do not trust timegm/gmtime on this machine', 9) if ($result ne '20070805004024');
is ($result, 20070805004024, "now set up with hard coded date");

#use Data::Dumper; print STDERR "timegm now is ". timegm(24,40,0,5, 7, 2007)."\n";

$result =
 $date_parser->parse_and_evaluate("now - 10s");
#print "NResult minus 10 is $result\n";
is ($result, 20070805004014, "10 seconds before hard coded date");

$result =
 $date_parser->parse_and_evaluate("now + 70h");
#print "NResult plus 70 hours is $result\n";
is ($result, 20070807224024, "70 hours after hard coded date");

$result =
 $date_parser->parse_and_evaluate("now + 70h +3s");
#print "NResult plus 70 hours plus 3 sec is $result\n";
is ($result, 20070807224027, "70 hours 3 secs after hard coded date");

$result =
 $date_parser->parse_and_evaluate("3/22/2007");
#print "NResult march 22 2007is $result\n";
is ($result, 20070322000000, "3/22/2007");

$result =
 $date_parser->parse_and_evaluate("2/21/2007 + 5d");
#print "NResult march 22 2007 plus 5 days is $result\n";
is ($result, 20070226000000, "2/21/2007 and 5 days");

$result =
 $date_parser->parse_and_evaluate("2/22/2008 + 7d");
#print "NResult feb 22 2008 plus 7 days is $result\n";
is ($result, 20080229000000, "2/22/2008 and 7 days");

$result =
 $date_parser->parse_and_evaluate("2/22/2007 + 7d");
#print "NResult feb 22 2007 plus 7 days is $result\n";
is ($result, 20070301000000, "2/22/2008 and 7 days");

$result =
 $date_parser->parse_and_evaluate("2/22/2007 + 7D");
#print "NResult feb 22 2007 plus 7 days is $result\n";
is ($result, 20070301000000, "2/22/2008 plus 7 DAYS");


}

print "\nAll done\n";