1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
#!/usr/bin/perl
use strict;
use warnings;
use boolean qw(true);
use DateTime::Format::Natural;
use DateTime::Format::Natural::Test qw($case_strings);
use Test::More;
my @strings = (
{ 'see you next thurs for coffee', => [ 'next thu' ] },
{ "I'll meet you on 15th march at the cinema" => [ '15th march' ] },
{ 'payment is due in 30 days' => [ 'in 30 days' ] },
{ 'johann sebastian bach was born 21/03/1685' => [ '21/03/1685' ] },
{ '09/11/1989 18:57 was a historic moment' => [ '09/11/1989 18:57' ] },
{ 'readings start at 20:00 and 22:00' => [ qw(20:00 22:00) ] },
{ 'conference will take place from wednesday to friday' => [ 'wednesday to friday' ] },
{ 'free days are friday, saturday and sunday' => [ qw(friday saturday sunday) ] },
{ 'system is stopped friday; started early monday' => [ qw(friday monday) ] },
{ '02/03/2011 midnight and 02/03/2011 noon' => [ '02/03/2011 midnight', '02/03/2011 noon' ] },
{ '1969-07-20 and now' => [ qw(1969-07-20 now) ] },
{ '6:00 compared to 6' => [ '6:00' ] }, # ambiguous token missing
{ 'yesterday to today and today to tomorrow' => [ 'yesterday to today', 'today to tomorrow' ] },
{ 'tuesday wednesday' => [ qw(tuesday wednesday) ] },
{ 'we will stay for 3 days at the venue' => [ 'for 3 days' ] },
{ 'from first to last day of october forms a month' => [ 'first to last day of october' ] },
{ '26 oct at 10am to 11:00 is spare time' => [ '26 oct 10am to 11:00' ] },
{ '3 days ago to for 3 days' => [ '3 days ago', 'for 3 days' ] }, # separate for <count> <unit> grammar duration
);
my @expanded = (
{ 'started work at 6am last day' => [ '6am last day' ] },
);
my @rewrite = (
{ '6 am' => [ '6am' ] },
{ '8 pm' => [ '8pm' ] },
{ 'yesterday at noon' => [ 'yesterday noon' ] },
{ 'yesterday at midnight' => [ 'yesterday midnight' ] },
{ 'today at 6 am' => [ 'today 6am' ] },
{ 'today at 8 pm' => [ 'today 8pm' ] },
{ 'tomorrow at 6' => [ 'tomorrow 6:00' ] },
{ 'tomorrow at 20' => [ 'tomorrow 20:00' ] },
);
my @punctuation = (
{ 'dec 18, 1987' => [ 'dec 18 1987' ] },
{ 'sunday, monday' => [ 'sunday', 'monday' ] },
{ 'sunday; monday' => [ 'sunday', 'monday' ] },
{ 'sunday. monday' => [ 'sunday', 'monday' ] },
{ ',tuesday' => [ 'tuesday' ] },
{ ';tuesday' => [ 'tuesday' ] },
{ '.tuesday' => [ 'tuesday' ] },
{ 'wednesday,' => [ 'wednesday' ] },
{ 'wednesday;' => [ 'wednesday' ] },
{ 'wednesday.' => [ 'wednesday' ] },
{ ' ,thursday' => [ 'thursday' ] },
{ 'thursday, ' => [ 'thursday' ] },
);
my @spaces = (
{ 'wednesday this week' => [ 'wednesday this week' ] },
{ 'first to last day of jan' => [ 'first to last day of jan' ] },
{ '2013-01-16 8pm to 10pm' => [ '2013-01-16 8pm to 10pm' ] },
);
# sanity checks
my @duration = (
{ 'monday to to friday' => [ qw(monday friday) ] },
{ 'saturday to' => [ 'saturday' ] },
{ 'to saturday' => [ 'saturday' ] },
{ 'this year to next year to' => [ 'this year to next year' ] },
{ 'feb to may to oct to dec' => [ 'feb to may', 'oct to dec' ] },
);
my @durations = (
# combined
{ 'first to last day of september' => [ 'first to last day of september' ] },
{ 'first to last day of 2008' => [ 'first to last day of 2008' ] },
# relative
{ '2009-03-10 at 9:00 to 11:00' => [ '2009-03-10 9:00 to 11:00' ] },
{ '26 oct 10am to 11:00' => [ '26 oct 10am to 11:00' ] },
{ 'may 2nd to 5th' => [ 'may 2nd to 5th' ] },
{ 'jan 1 to 2nd' => [ 'jan 1 to 2nd' ] },
{ '16:00 6 nov to 17:00' => [ '16:00 6 nov to 17:00' ] },
{ '24 dec to 26' => [ '24 dec to 26' ] },
{ '100th day to 200th' => [ '100th day to 200th' ] },
{ '30th to 31st dec' => [ '30th to 31st dec' ] },
{ '30th to dec 31st' => [ '30th to dec 31st' ] },
{ '21:00 to mar 3 22:00' => [ '21:00 to mar 3 22:00' ] },
{ '21:00 to 22:00 mar 3' => [ '21:00 to 22:00 mar 3' ] },
{ '10th to 20th day' => [ '10th to 20th day' ] },
# rewrite
{ 'today at 5pm to tomorrow at 6am' => [ 'today 5pm to tomorrow 6am' ] },
{ 'monday 7 am to friday 5 pm' => [ 'monday 7am to friday 5pm' ] },
{ 'tues to thurs' => [ 'tue to thu' ] },
{ 'sat @ 2 to sun @ 6' => [ 'sat 2:00 to sun 6:00' ] },
);
# Check that looping works for those kind of durations.
my @assert = (
{ 'jan 1st to 31st foo first to last day of dec' => [ 'jan 1st to 31st', 'first to last day of dec' ] },
);
foreach my $set (\@strings, \@expanded, \@rewrite, \@punctuation, \@spaces, \@duration, \@durations, \@assert) {
compare($set);
}
sub compare
{
my $aref = shift;
foreach my $href (@$aref) {
my $key = (keys %$href)[0];
foreach my $string ($case_strings->($key)) {
compare_strings($string, $href->{$key});
}
}
}
sub compare_strings
{
my ($string, $result) = @_;
my $parser = DateTime::Format::Natural->new;
my @expressions = $parser->extract_datetime($string);
if (@expressions) {
my $equal = is_deeply([ map lc, @expressions ], $result, "$string (extracting)");
SKIP: {
skip 'extracted expressions differ', 1 unless $equal;
# eval in order to avoid fatal errors on some older perls
my $parses = eval true;
foreach my $expression (@expressions) {
$parser->parse_datetime_duration($expression);
$parses &= $parser->success;
}
ok($parses, "$string (parsing)");
}
}
else {
fail($string);
}
}
done_testing();
|
