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   270 use strict;
  26         57  
  26         821  
4 26     26   161 use warnings;
  26         66  
  26         725  
5              
6 26     26   13009 use DateTime::Format::Natural::Duration::Checks;
  26         102  
  26         998  
7 26     26   204 use List::MoreUtils qw(all);
  26         62  
  26         357  
8              
9             our $VERSION = '0.07';
10              
11             sub _pre_duration
12             {
13 1258     1258   2848 my $self = shift;
14 1258         2598 my ($date_strings) = @_;
15              
16             my $check_if = sub
17             {
18 3637     3637   33283 my $sub = shift;
19 3637         6593 my $class = join '::', (__PACKAGE__, 'Checks');
20 3637 50       21014 my $check = $class->can($sub) or die "$sub() not found in $class";
21              
22 3637         13778 return $check->($self->{data}->{duration}, $date_strings, @_);
23 1258         5951 };
24              
25 1258         3076 my ($present, $extract, $adjust, @indexes);
26              
27 1258 100       3036 if ($check_if->('for', \$present)) {
    100          
    100          
28 55         676 @{$self->{insert}}{qw(datetime trace)} = do {
  55         193  
29 55         181 my $dt = $self->parse_datetime($present);
30 55         197 ($dt, $self->{traces}[0]);
31             };
32 55 100       317 if ($self->{running_tests}) {
33 48         446 $self->{insert}{truncated} = $self->_get_truncated;
34             }
35             }
36             elsif ($check_if->('first_to_last', \$extract)) {
37 27 50       611 if (my ($complete) = $date_strings->[1] =~ $extract) {
38 27         264 $date_strings->[0] .= " $complete";
39             }
40             }
41             elsif ($check_if->('from_count_to_count', \$extract, \$adjust, \@indexes)) {
42 899 50       22627 if (my ($complete) = $date_strings->[$indexes[0]] =~ $extract) {
43 899         3235 $adjust->($date_strings, $indexes[1], $complete);
44             }
45             }
46             }
47              
48             sub _post_duration
49             {
50 1258     1258   2571 my $self = shift;
51 1258         3464 my ($queue, $traces, $truncated) = @_;
52              
53 1258         5087 my %assign = (
54             datetime => $queue,
55             trace => $traces,
56             truncated => $truncated,
57             );
58 1258 100       3660 delete $assign{truncated} unless $self->{running_tests};
59              
60 1258 100   1361   16898 if (all { exists $self->{insert}{$_} } keys %assign) {
  1361         6325  
61 55         170 unshift @{$assign{$_}}, $self->{insert}{$_} foreach keys %assign;
  158         480  
62             }
63             }
64              
65             sub _save_state
66             {
67 2297     2297   4410 my $self = shift;
68 2297         7495 my %args = @_;
69              
70 2297 100       3990 return if %{$self->{state}};
  2297         7342  
71              
72 2294 100       8281 unless ($args{valid_expression}) {
73 3         38 %{$self->{state}} = %args;
  3         28  
74             }
75             }
76              
77             sub _restore_state
78             {
79 1258     1258   2600 my $self = shift;
80              
81 1258         2363 my %state = %{$self->{state}};
  1258         3915  
82              
83 1258 100       5023 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       15 ? $self->_set_failure
90             : $self->_unset_failure;
91              
92             defined $state{error}
93             ? $self->_set_error($state{error})
94 3 100       33 : $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