File Coverage

blib/lib/DateTime/Format/Natural/Duration.pm
Criterion Covered Total %
statement 53 53 100.0
branch 26 30 86.6
condition n/a
subroutine 10 10 100.0
pod n/a
total 89 93 95.7


line stmt bran cond sub pod time code
1             package DateTime::Format::Natural::Duration;
2              
3 26     26   232 use strict;
  26         68  
  26         817  
4 26     26   140 use warnings;
  26         74  
  26         699  
5              
6 26     26   12350 use DateTime::Format::Natural::Duration::Checks;
  26         73  
  26         1381  
7 26     26   210 use List::MoreUtils qw(all);
  26         76  
  26         377  
8              
9             our $VERSION = '0.07';
10              
11             sub _pre_duration
12             {
13 1258     1258   2347 my $self = shift;
14 1258         2706 my ($date_strings) = @_;
15              
16             my $check_if = sub
17             {
18 3637     3637   31661 my $sub = shift;
19 3637         6732 my $class = join '::', (__PACKAGE__, 'Checks');
20 3637 50       19202 my $check = $class->can($sub) or die "$sub() not found in $class";
21              
22 3637         12730 return $check->($self->{data}->{duration}, $date_strings, @_);
23 1258         5640 };
24              
25 1258         3046 my ($present, $extract, $adjust, @indexes);
26              
27 1258 100       3374 if ($check_if->('for', \$present)) {
    100          
    100          
28 55         688 @{$self->{insert}}{qw(datetime trace)} = do {
  55         180  
29 55         181 my $dt = $self->parse_datetime($present);
30 55         187 ($dt, $self->{traces}[0]);
31             };
32 55 100       260 if ($self->{running_tests}) {
33 48         452 $self->{insert}{truncated} = $self->_get_truncated;
34             }
35             }
36             elsif ($check_if->('first_to_last', \$extract)) {
37 27 50       656 if (my ($complete) = $date_strings->[1] =~ $extract) {
38 27         229 $date_strings->[0] .= " $complete";
39             }
40             }
41             elsif ($check_if->('from_count_to_count', \$extract, \$adjust, \@indexes)) {
42 899 50       21832 if (my ($complete) = $date_strings->[$indexes[0]] =~ $extract) {
43 899         2951 $adjust->($date_strings, $indexes[1], $complete);
44             }
45             }
46             }
47              
48             sub _post_duration
49             {
50 1258     1258   2332 my $self = shift;
51 1258         3056 my ($queue, $traces, $truncated) = @_;
52              
53 1258         4615 my %assign = (
54             datetime => $queue,
55             trace => $traces,
56             truncated => $truncated,
57             );
58 1258 100       3562 delete $assign{truncated} unless $self->{running_tests};
59              
60 1258 100   1361   15888 if (all { exists $self->{insert}{$_} } keys %assign) {
  1361         6198  
61 55         179 unshift @{$assign{$_}}, $self->{insert}{$_} foreach keys %assign;
  158         468  
62             }
63             }
64              
65             sub _save_state
66             {
67 2297     2297   4114 my $self = shift;
68 2297         7424 my %args = @_;
69              
70 2297 100       3876 return if %{$self->{state}};
  2297         7125  
71              
72 2294 100       7937 unless ($args{valid_expression}) {
73 3         34 %{$self->{state}} = %args;
  3         15  
74             }
75             }
76              
77             sub _restore_state
78             {
79 1258     1258   2463 my $self = shift;
80              
81 1258         2173 my %state = %{$self->{state}};
  1258         3695  
82              
83 1258 100       4083 if (%state) {
84             $state{valid_expression}
85 3 50       15 ? $self->_set_valid_exp
86             : $self->_unset_valid_exp;
87              
88             $state{failure}
89 3 100       19 ? $self->_set_failure
90             : $self->_unset_failure;
91              
92             defined $state{error}
93             ? $self->_set_error($state{error})
94 3 100       29 : $self->_unset_error;
95             }
96             }
97              
98             1;
99             __END__
100              
101             =head1 NAME
102              
103             DateTime::Format::Natural::Duration - Duration hooks and state handling
104              
105             =head1 SYNOPSIS
106              
107             Please see the DateTime::Format::Natural documentation.
108              
109             =head1 DESCRIPTION
110              
111             The C<DateTime::Format::Natural::Duration> class contains code to alter
112             tokens before parsing and to insert DateTime objects in the resulting
113             queue. Furthermore, there's code to save the state of the first failing
114             parse and restore it after the duration has been processed.
115              
116             =head1 SEE ALSO
117              
118             L<DateTime::Format::Natural>
119              
120             =head1 AUTHOR
121              
122             Steven Schubiger <schubiger@cpan.org>
123              
124             =head1 LICENSE
125              
126             This program is free software; you may redistribute it and/or
127             modify it under the same terms as Perl itself.
128              
129             See L<http://dev.perl.org/licenses/>
130              
131             =cut