line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Format::Natural::Rewrite; |
2
|
|
|
|
|
|
|
|
3
|
26
|
|
|
26
|
|
252
|
use strict; |
|
26
|
|
|
|
|
67
|
|
|
26
|
|
|
|
|
1155
|
|
4
|
26
|
|
|
26
|
|
178
|
use warnings; |
|
26
|
|
|
|
|
70
|
|
|
26
|
|
|
|
|
23537
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.08'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub _rewrite |
9
|
|
|
|
|
|
|
{ |
10
|
11912
|
|
|
11912
|
|
21859
|
my $self = shift; |
11
|
11912
|
|
|
|
|
25740
|
my ($date_string) = @_; |
12
|
|
|
|
|
|
|
|
13
|
11912
|
|
|
|
|
28858
|
foreach my $type (qw(regular aliases conditional)) { |
14
|
35736
|
|
|
|
|
85724
|
my $method = "_rewrite_$type"; |
15
|
35736
|
|
|
|
|
106060
|
$self->$method($date_string); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub _rewrite_regular |
20
|
|
|
|
|
|
|
{ |
21
|
11912
|
|
|
11912
|
|
20272
|
my $self = shift; |
22
|
11912
|
|
|
|
|
22218
|
my ($date_string) = @_; |
23
|
|
|
|
|
|
|
|
24
|
11912
|
|
|
|
|
34005
|
$$date_string =~ tr/,//d; |
25
|
11912
|
|
|
|
|
75198
|
$$date_string =~ s/\s+?(am|pm)\b/$1/gi; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _rewrite_conditional |
29
|
|
|
|
|
|
|
{ |
30
|
11912
|
|
|
11912
|
|
22133
|
my $self = shift; |
31
|
11912
|
|
|
|
|
24755
|
my ($date_string) = @_; |
32
|
|
|
|
|
|
|
|
33
|
11912
|
|
|
|
|
25801
|
my $rewrite = $self->{data}->{rewrite}; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
REWRITE: { |
36
|
11912
|
100
|
|
|
|
19590
|
if ($$date_string =~ /$rewrite->{at}{match}/g) { |
|
14411
|
|
|
|
|
163552
|
|
37
|
2505
|
|
|
|
|
8808
|
my $last_token = $1; |
38
|
|
|
|
|
|
|
my @regexes = ( |
39
|
|
|
|
|
|
|
(map $self->{data}->__RE($_), qw(time time_am time_pm)), |
40
|
|
|
|
|
|
|
$rewrite->{at}{daytime}, |
41
|
2505
|
|
|
|
|
19505
|
); |
42
|
2505
|
|
|
|
|
7966
|
foreach my $regex (@regexes) { |
43
|
5451
|
100
|
|
|
|
36472
|
if ($last_token =~ $regex) { |
44
|
2499
|
100
|
|
|
|
10693
|
$$date_string =~ s/\G/:00/ if $last_token =~ /^\d{1,2}$/; |
45
|
2499
|
|
|
|
|
17286
|
$$date_string =~ s/$rewrite->{at}{subst}//; |
46
|
2499
|
|
|
|
|
9683
|
redo REWRITE; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _rewrite_aliases |
54
|
|
|
|
|
|
|
{ |
55
|
11912
|
|
|
11912
|
|
21893
|
my $self = shift; |
56
|
11912
|
|
|
|
|
24015
|
my ($date_string) = @_; |
57
|
|
|
|
|
|
|
|
58
|
11912
|
|
|
|
|
27688
|
my $aliases = $self->{data}->{aliases}; |
59
|
|
|
|
|
|
|
|
60
|
11912
|
100
|
|
|
|
48911
|
if ($$date_string =~ /\s+/) { |
61
|
10276
|
|
|
|
|
23382
|
foreach my $type (qw(words tokens)) { |
62
|
20552
|
|
|
|
|
35087
|
foreach my $alias (keys %{$aliases->{$type}}) { |
|
20552
|
|
|
|
|
80174
|
|
63
|
143864
|
100
|
|
|
|
422966
|
if ($alias =~ /^\w+$/) { |
64
|
133588
|
|
|
|
|
991643
|
$$date_string =~ s/\b $alias \b/$aliases->{$type}{$alias}/gix; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
else { |
67
|
10276
|
|
|
|
|
44940
|
$$date_string =~ s/(?:^|(?<=\s)) $alias (?:(?=\s)|$)/$aliases->{$type}{$alias}/gix; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
else { |
73
|
1636
|
|
|
|
|
2928
|
foreach my $alias (keys %{$aliases->{words}}) { |
|
1636
|
|
|
|
|
5720
|
|
74
|
4908
|
|
|
|
|
48218
|
$$date_string =~ s/^ $alias $/$aliases->{words}{$alias}/ix; |
75
|
|
|
|
|
|
|
} |
76
|
1636
|
|
|
|
|
4046
|
foreach my $alias (keys %{$aliases->{short}}) { |
|
1636
|
|
|
|
|
5548
|
|
77
|
3272
|
|
|
|
|
45192
|
$$date_string =~ s/(?<=\d) $alias $/$aliases->{short}{$alias}/ix; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub _rewrite_duration |
83
|
|
|
|
|
|
|
{ |
84
|
1258
|
|
|
1258
|
|
2717
|
my $self = shift; |
85
|
1258
|
|
|
|
|
2770
|
my ($date_strings) = @_; |
86
|
|
|
|
|
|
|
|
87
|
1258
|
|
|
|
|
6905
|
my ($formatted) = $date_strings->[0] =~ $self->{data}->__regexes('format'); |
88
|
1258
|
|
|
|
|
5856
|
my %count = $self->_count_separators($formatted); |
89
|
|
|
|
|
|
|
|
90
|
1258
|
100
|
100
|
|
|
4677
|
return unless ($self->_check_formatted('ymd', \%count) |
91
|
|
|
|
|
|
|
|| $self->_check_formatted('md', \%count)); |
92
|
|
|
|
|
|
|
|
93
|
137
|
100
|
|
|
|
1472
|
if ($date_strings->[0] =~ /^ \Q$formatted\E \s+ \d{1,2} $/x) { |
94
|
12
|
|
|
|
|
40
|
$date_strings->[0] .= ':00'; |
95
|
|
|
|
|
|
|
} |
96
|
137
|
100
|
100
|
|
|
1119
|
if (@$date_strings == 2 |
97
|
|
|
|
|
|
|
&& $date_strings->[1] =~ /^ \d{1,2} $/x) |
98
|
|
|
|
|
|
|
{ |
99
|
12
|
|
|
|
|
55
|
$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 |