view release on metacpan or  search on metacpan

lib/App/JobLog/TimeGrammar.pm  view on Meta::CPAN

      ((?&date)) (?{ $d1 = $^N; stow($d1) })
      (?: (?&span_divider) ((?&date)) (?{ $d2 = $^N; stow($d2) }) )?
     )

     (?<span_divider> \s*+ (?: -++ | \b(?: through | thru | to | till?+ | until )\b ) \s*+)

     (?<at> at | @ )

     (?<at_time> 
       (?{ $time_buffer = undef })
       (?: (?: \s++ | \s*+ (?&at) \s*+ ) (?&time))? 
     )

     (?<at_time_on> (?:(?&at) \s++)? (?&time) \s++ on \s++ )

     (?<date>
      (?{ (%buffer, $b1, $b2, $time_buffer) = ()})
      (?: (?&numeric) | (?&verbal) )
      (?{ $buffer{time} = $time_buffer if $time_buffer })
     )
     
     (?<time>
      (?{ $time_buffer = undef })
      (
       \d{1,2}
       (?:
        : \d{2}
        (?:
         : \d{2}
        )?
       )? 
       (?: \s*+ (?&time_suffix))?
      )
      (?{ $time_buffer = $^N })
     )

     (?<time_suffix> [ap] (?:m|\.m\.))

     (?<numeric> 
      (?:
       (?&year)
       |
       (?&ym)
       |
       (?&at_time_on) (?&numeric_no_time)
       |
       (?&numeric_no_time) (?&at_time))
      (?{ $buffer{type} = 'numeric' })
     )
     
     (?<year> (?{ %buffer = () }) (\d{4}) (?{ $buffer{year} = $^N }) ) 
     
     (?<ym> (?&year) (?&divider) (\d{1,2}) (?{ @buffer{qw(month unit)} = ($^N, 'months') }) )

     (?<numeric_no_time> (?{ %buffer = () }) (?&us) | (?&iso) | (?&md) | (?&dom) )

     (?<us>
      (\d{1,2}) (?{ $b1 = $^N })
      ((?&divider))
      (\d{1,2}) (?{ $b2 = $^N })
      \g{-2}
      (\d{4})
      (?{
       $buffer{year}  = $^N;
       $buffer{month} = $b1;
       $buffer{day}   = $b2;
      })
     )

     (?<iso>
      (\d{4}) (?{ $b1 = $^N })
      ((?&divider))
      (\d{1,2}) (?{ $b2 = $^N })
      \g{-2}
      (\d{1,2})
      (?{
       $buffer{year}  = $b1;
       $buffer{month} = $b2;
       $buffer{day}   = $^N;
      })
     )

     (?<md>
      (\d{1,2}) (?{ $b1 = $^N })
      (?&divider)
      (\d{1,2})
      (?{
       $buffer{month} = $b1;
       $buffer{day}   = $^N;
      })
     )

     (?<dom>
      (\d{1,2})
      (?{ $buffer{day} = $^N })
     )

     (?<verbal>
      (?: (?&my) | (?&named_period) | (?&relative_period) | (?&month_day) | (?&full) ) 
      (?{ $buffer{type} = 'verbal' })
     )

     (?<named_period> (?&modifiable_day) | (?&modifiable_month) | (?&modifiable_period) )

     (?<modifiable_day> (?&at_time_on) (?&modifiable_day_no_time) | (?&modifiable_day_no_time) (?&at_time))

     (?<modifiable_day_no_time>
      ((?:(?&modifier) \s++ )?) (?{ $b1 = $^N })
      ((?&weekday))
      (?{
       $buffer{modifier} = $b1 if $b1;
       $buffer{day}      = $^N; 
      })
     )

     (?<modifiable_month>
      ((?:(?&month_modifier) \s++ )?) (?{ $b1 = $^N })
      ((?&month))
      (?{
       $buffer{modifier} = $b1 if $b1;
       $buffer{month}    = $^N; 
      })
     )

     (?<modifiable_period>
       (?{ $b1 = undef })
       (?:((?&period_modifier)) \s*+  (?{ $b1 = $^N }))?
       ((?&period))
       (?{
	$buffer{modifier} = $b1 if $b1;
	$buffer{period}   = $^N;
       })
     )

lib/App/JobLog/TimeGrammar.pm  view on Meta::CPAN

      ((?&month)) (?{ $b2 = $^N })
      \s++
      (\d{1,2}) (?{ $b1 = $^N })
      , \s++
      (\d{4})
      (?{
       $buffer{year}  = $^N;
       $buffer{month} = $b2;
       $buffer{day}   = $b1;
      })
     )

     (?<weekday> (?&full_weekday) | (?&short_weekday) )

     (?<full_weekday> sunday | monday | tuesday | wednesday | thursday | friday | saturday )

     (?<short_weekday> sun | mon | tue | wed | thu | fri | sat )

     (?<month> (?&full_month) | (?&short_month) )

     (?<full_month> january | february | march | april | may | june | july | august | september | october | november | december )

     (?<short_month> jan | feb | mar | apr | may | jun | jul | aug | sep | oct | nov | dec )

     (?<modifier> last | this | next )

     (?<period_modifier> (?&modifier) | (?&termini) (?: \s++ of (?: \s++ the )? )? )
     
     (?<period> week | month | year | (?&pay) )

     (?<month_modifier> (?&modifier) | (?&termini) (?: \s++ of )? )

     (?<termini> (?: the \s++ )? (?: (?&beginning) | end ) )

     (?<beginning> beg(?:in(?:ning)?)?)

     (?<divider> [-/.])

    )
}xi;

# stows everything matched so far in %matches
sub stow {
    my %h = %buffer;
    $matches{ $_[0] } = \%h;
    %buffer = ();
}


sub daytime {
    my $time = shift;

    #parse
    $time =~ /(?<hour>\d++)
                  (?:
                   : (?<minute>\d++)
                   (?:
                    : (?<second>\d++)
                   )?
                  )?
                  (?: \s*+ (?<suffix>[ap]) (\.?)m\g{-1})?
                 /ix;
    my ( $hour, $minute, $second, $suffix ) =
      ( $+{hour}, $+{minute} || 0, $+{second} || 0, lc( $+{suffix} || 'x' ) );
    $hour += 12 if $suffix eq 'p' && $hour < 12;
    $suffix = 'p' if $hour > 11;
    $hour = 0 if $hour == 12 && $suffix eq 'a';
    croak
      "impossible time: $time" #<--- syntax error at (eval 4158) line 23, near "croak "impossible time: $time""

      if $hour > 23
          || $minute > 59
          || $second > 59
          || $suffix eq 'a' && $hour > 12;
    $hour = 0 if $suffix eq 'a' && $hour == 12;
    return (
        hour   => $hour,
        minute => $minute,
        second => $second,
        suffix => $suffix
    );
}


sub parse {
    my $phrase = shift;
    local ( %matches, %buffer, $d1, $d2, $b1, $b2, $time_buffer );
    if ( $phrase =~ $re ) {
        if ( $matches{ever} ) {

            # we want the entire timespan of the log
            my ($se) = App::JobLog::Log->new->first_event;
            if ($se) {
                return $se->start, now, 0;
            }
            else {
                return now->subtract( seconds => 1 ), now, 0;
            }
        }

        my $h1   = $matches{$d1};
        my $unit = delete $h1->{unit};
        normalize($h1);
        if ($unit) {

            # $h1 is necessarily fixed and there is no time associated
            $h1 = fix_date( $h1, 1 );
            my $h2 = $h1->clone->add( $unit => 1 )->subtract( seconds => 1 );
            return $h1, $h2, 1;
        }
        else {
            my %t1 = extract_time( $h1, 1 );
            my ( $h2, $count, %t2 );
            if ( $d2 && $matches{$d2} ) {
                $h2 = $matches{$d2};
                normalize($h2);
                %t2    = extract_time($h2);
                $count = 2;
            }
            else {
                $h2    = {%$h1};