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   242 use strict;
  26         63  
  26         910  
4 26     26   159 use warnings;
  26         73  
  26         715  
5              
6 26     26   13393 use DateTime::Format::Natural::Duration::Checks;
  26         90  
  26         1043  
7 26     26   210 use List::MoreUtils qw(all);
  26         65  
  26         366  
8              
9             our $VERSION = '0.07';
10              
11             sub _pre_duration
12             {
13 1258     1258   2470 my $self = shift;
14 1258         2571 my ($date_strings) = @_;
15              
16             my $check_if = sub
17             {
18 3637     3637   32439 my $sub = shift;
19 3637         6553 my $class = join '::', (__PACKAGE__, 'Checks');
20 3637 50       19294 my $check = $class->can($sub) or die "$sub() not found in $class";
21              
22 3637         13294 return $check->($self->{data}->{duration}, $date_strings, @_);
23 1258         5817 };
24              
25 1258         2821 my ($present, $extract, $adjust, @indexes);
26              
27 1258 100       2819 if ($check_if->('for', \$present)) {
    100          
    100          
28 55         696 @{$self->{insert}}{qw(datetime trace)} = do {
  55         184  
29 55         228 my $dt = $self->parse_datetime($present);
30 55         193 ($dt, $self->{traces}[0]);
31             };
32 55 100       256 if ($self->{running_tests}) {
33 48         433 $self->{insert}{truncated} = $self->_get_truncated;
34             }
35             }
36             elsif ($check_if->('first_to_last', \$extract)) {
37 27 50       633 if (my ($complete) = $date_strings->[1] =~ $extract) {
38 27         231 $date_strings->[0] .= " $complete";
39             }
40             }
41             elsif ($check_if->('from_count_to_count', \$extract, \$adjust, \@indexes)) {
42 899 50       22052 if (my ($complete) = $date_strings->[$indexes[0]] =~ $extract) {
43 899         3313 $adjust->($date_strings, $indexes[1], $complete);
44             }
45             }
46             }
47              
48             sub _post_duration
49             {
50 1258     1258   2639 my $self = shift;
51 1258         3070 my ($queue, $traces, $truncated) = @_;
52              
53 1258         4531 my %assign = (
54             datetime => $queue,
55             trace => $traces,
56             truncated => $truncated,
57             );
58 1258 100       3334 delete $assign{truncated} unless $self->{running_tests};
59              
60 1258 100   1361   16107 if (all { exists $self->{insert}{$_} } keys %assign) {
  1361         6242  
61 55         166 unshift @{$assign{$_}}, $self->{insert}{$_} foreach keys %assign;
  158         512  
62             }
63             }
64              
65             sub _save_state
66             {
67 2297     2297   4129 my $self = shift;
68 2297         8332 my %args = @_;
69              
70 2297 100       3903 return if %{$self->{state}};
  2297         7261  
71              
72 2294 100       8139 unless ($args{valid_expression}) {
73 3         47 %{$self->{state}} = %args;
  3         15  
74             }
75             }
76              
77             sub _restore_state
78             {
79 1258     1258   2427 my $self = shift;
80              
81 1258         2117 my %state = %{$self->{state}};
  1258         3928  
82              
83 1258 100       4418 if (%state) {
84             $state{valid_expression}
85 3 50       16 ? $self->_set_valid_exp
86             : $self->_unset_valid_exp;
87              
88             $state{failure}
89 3 100       17 ? $self->_set_failure
90             : $self->_unset_failure;
91              
92             defined $state{error}
93             ? $self->_set_error($state{error})
94 3 100       27 : $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