line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Format::Natural::Rewrite; |
2
|
|
|
|
|
|
|
|
3
|
26
|
|
|
26
|
|
237
|
use strict; |
|
26
|
|
|
|
|
67
|
|
|
26
|
|
|
|
|
1075
|
|
4
|
26
|
|
|
26
|
|
168
|
use warnings; |
|
26
|
|
|
|
|
56
|
|
|
26
|
|
|
|
|
22343
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.08'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub _rewrite |
9
|
|
|
|
|
|
|
{ |
10
|
11912
|
|
|
11912
|
|
20810
|
my $self = shift; |
11
|
11912
|
|
|
|
|
25180
|
my ($date_string) = @_; |
12
|
|
|
|
|
|
|
|
13
|
11912
|
|
|
|
|
28659
|
foreach my $type (qw(regular aliases conditional)) { |
14
|
35736
|
|
|
|
|
82221
|
my $method = "_rewrite_$type"; |
15
|
35736
|
|
|
|
|
99974
|
$self->$method($date_string); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub _rewrite_regular |
20
|
|
|
|
|
|
|
{ |
21
|
11912
|
|
|
11912
|
|
19706
|
my $self = shift; |
22
|
11912
|
|
|
|
|
20506
|
my ($date_string) = @_; |
23
|
|
|
|
|
|
|
|
24
|
11912
|
|
|
|
|
31900
|
$$date_string =~ tr/,//d; |
25
|
11912
|
|
|
|
|
73263
|
$$date_string =~ s/\s+?(am|pm)\b/$1/gi; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _rewrite_conditional |
29
|
|
|
|
|
|
|
{ |
30
|
11912
|
|
|
11912
|
|
21031
|
my $self = shift; |
31
|
11912
|
|
|
|
|
22393
|
my ($date_string) = @_; |
32
|
|
|
|
|
|
|
|
33
|
11912
|
|
|
|
|
23687
|
my $rewrite = $self->{data}->{rewrite}; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
REWRITE: { |
36
|
11912
|
100
|
|
|
|
19049
|
if ($$date_string =~ /$rewrite->{at}{match}/g) { |
|
14411
|
|
|
|
|
158562
|
|
37
|
2505
|
|
|
|
|
8703
|
my $last_token = $1; |
38
|
|
|
|
|
|
|
my @regexes = ( |
39
|
|
|
|
|
|
|
(map $self->{data}->__RE($_), qw(time time_am time_pm)), |
40
|
|
|
|
|
|
|
$rewrite->{at}{daytime}, |
41
|
2505
|
|
|
|
|
18281
|
); |
42
|
2505
|
|
|
|
|
7885
|
foreach my $regex (@regexes) { |
43
|
5451
|
100
|
|
|
|
35450
|
if ($last_token =~ $regex) { |
44
|
2499
|
100
|
|
|
|
9828
|
$$date_string =~ s/\G/:00/ if $last_token =~ /^\d{1,2}$/; |
45
|
2499
|
|
|
|
|
16506
|
$$date_string =~ s/$rewrite->{at}{subst}//; |
46
|
2499
|
|
|
|
|
9172
|
redo REWRITE; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _rewrite_aliases |
54
|
|
|
|
|
|
|
{ |
55
|
11912
|
|
|
11912
|
|
20127
|
my $self = shift; |
56
|
11912
|
|
|
|
|
21371
|
my ($date_string) = @_; |
57
|
|
|
|
|
|
|
|
58
|
11912
|
|
|
|
|
25337
|
my $aliases = $self->{data}->{aliases}; |
59
|
|
|
|
|
|
|
|
60
|
11912
|
100
|
|
|
|
45626
|
if ($$date_string =~ /\s+/) { |
61
|
10276
|
|
|
|
|
22424
|
foreach my $type (qw(words tokens)) { |
62
|
20552
|
|
|
|
|
34586
|
foreach my $alias (keys %{$aliases->{$type}}) { |
|
20552
|
|
|
|
|
74520
|
|
63
|
143864
|
100
|
|
|
|
414199
|
if ($alias =~ /^\w+$/) { |
64
|
133588
|
|
|
|
|
976178
|
$$date_string =~ s/\b $alias \b/$aliases->{$type}{$alias}/gix; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
else { |
67
|
10276
|
|
|
|
|
41561
|
$$date_string =~ s/(?:^|(?<=\s)) $alias (?:(?=\s)|$)/$aliases->{$type}{$alias}/gix; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
else { |
73
|
1636
|
|
|
|
|
2968
|
foreach my $alias (keys %{$aliases->{words}}) { |
|
1636
|
|
|
|
|
5553
|
|
74
|
4908
|
|
|
|
|
47507
|
$$date_string =~ s/^ $alias $/$aliases->{words}{$alias}/ix; |
75
|
|
|
|
|
|
|
} |
76
|
1636
|
|
|
|
|
4199
|
foreach my $alias (keys %{$aliases->{short}}) { |
|
1636
|
|
|
|
|
5413
|
|
77
|
3272
|
|
|
|
|
45204
|
$$date_string =~ s/(?<=\d) $alias $/$aliases->{short}{$alias}/ix; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub _rewrite_duration |
83
|
|
|
|
|
|
|
{ |
84
|
1258
|
|
|
1258
|
|
2290
|
my $self = shift; |
85
|
1258
|
|
|
|
|
2826
|
my ($date_strings) = @_; |
86
|
|
|
|
|
|
|
|
87
|
1258
|
|
|
|
|
6772
|
my ($formatted) = $date_strings->[0] =~ $self->{data}->__regexes('format'); |
88
|
1258
|
|
|
|
|
5922
|
my %count = $self->_count_separators($formatted); |
89
|
|
|
|
|
|
|
|
90
|
1258
|
100
|
100
|
|
|
4698
|
return unless ($self->_check_formatted('ymd', \%count) |
91
|
|
|
|
|
|
|
|| $self->_check_formatted('md', \%count)); |
92
|
|
|
|
|
|
|
|
93
|
137
|
100
|
|
|
|
1462
|
if ($date_strings->[0] =~ /^ \Q$formatted\E \s+ \d{1,2} $/x) { |
94
|
12
|
|
|
|
|
43
|
$date_strings->[0] .= ':00'; |
95
|
|
|
|
|
|
|
} |
96
|
137
|
100
|
100
|
|
|
1053
|
if (@$date_strings == 2 |
97
|
|
|
|
|
|
|
&& $date_strings->[1] =~ /^ \d{1,2} $/x) |
98
|
|
|
|
|
|
|
{ |
99
|
12
|
|
|
|
|
51
|
$date_strings->[1] .= ':00'; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
1; |
104
|
|
|
|
|
|
|
__END__ |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 NAME |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
DateTime::Format::Natural::Rewrite - Aliasing and rewriting of date strings |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 SYNOPSIS |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Please see the DateTime::Format::Natural documentation. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 DESCRIPTION |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
The C<DateTime::Format::Natural::Rewrite> class handles aliases and regular |
117
|
|
|
|
|
|
|
rewrites of date strings. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head1 SEE ALSO |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
L<DateTime::Format::Natural> |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 AUTHOR |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Steven Schubiger <schubiger@cpan.org> |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head1 LICENSE |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
This program is free software; you may redistribute it and/or |
130
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
See L<http://dev.perl.org/licenses/> |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |