r50898 - in /branches/upstream/libdatetime-format-natural-perl/current: ./ lib/DateTime/Format/ lib/DateTime/Format/Natural/ lib/DateTime/Format/Natural/Lang/ scripts/ t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Wed Jan 13 22:41:22 UTC 2010
Author: angelabad-guest
Date: Wed Jan 13 22:41:09 2010
New Revision: 50898
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=50898
Log:
[svn-upgrade] Integrating new upstream version, libdatetime-format-natural-perl (0.83)
Added:
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Formatted.pm
branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t (with props)
Modified:
branches/upstream/libdatetime-format-natural-perl/current/Changes
branches/upstream/libdatetime-format-natural-perl/current/MANIFEST
branches/upstream/libdatetime-format-natural-perl/current/META.yml
branches/upstream/libdatetime-format-natural-perl/current/README
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural.pm
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Duration.pm
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Helpers.pm
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Lang/EN.pm
branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Utils.pm
branches/upstream/libdatetime-format-natural-perl/current/scripts/dateparse
branches/upstream/libdatetime-format-natural-perl/current/t/00-load.t
branches/upstream/libdatetime-format-natural-perl/current/t/02-parse_format.t
branches/upstream/libdatetime-format-natural-perl/current/t/04-parse_durations.t
branches/upstream/libdatetime-format-natural-perl/current/t/06-parse_prefer_future.t
Modified: branches/upstream/libdatetime-format-natural-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/Changes?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/Changes (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/Changes Wed Jan 13 22:41:09 2010
@@ -1,4 +1,51 @@
Revision history for Perl extension DateTime::Format::Natural.
+
+0.83 Wed Jan 13 15:51:11 CET 2010
+
+ - Merged development version to stable.
+
+0.82_02 Wed Jan 6 10:57:43 CET 2010
+
+ - New supported format: M/D. [rt #53187 - Shawn M. Moore]
+
+ - Handle the new format with prefer-future semantics.
+
+ - Add tests for the new format and also for related durations.
+
+ - Document the new format and variations of it.
+
+ - Restrict counting of format separators to the formatted substring.
+
+ - Move the code processing formatted dates to a separate class.
+
+ - Fix the checking for an invalid format parameter.
+
+ - Complete <date> <time> to <time> type of durations.
+
+ - Split the duration string at word boundary of the separator.
+
+ - Restore the datetime object for each parse when running tests.
+
+ - Test compile-time loading of Formatted.pm.
+
+0.82_01 Thu Dec 31 12:10:30 CET 2009
+
+ - Save the trace of each parse while processing a duration.
+
+ - Call for formatted dates the wrapper _set() instead of set()
+ in order to alter the modified counters.
+
+ - dateparse: when printing traces, print a trace for each object
+ returned.
+
+ - Add tests for the trace method and improve its documentation.
+
+ - Document possible bugs and caveats.
+
+ - Rename some variables with method name strings to be more
+ descriptive and also interpolate their strings initially.
+
+ - Substitute an expression for a block as used by 'map'.
0.82 Mon Dec 21 10:15:52 CET 2009
Modified: branches/upstream/libdatetime-format-natural-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/MANIFEST?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/MANIFEST (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/MANIFEST Wed Jan 13 22:41:09 2010
@@ -5,6 +5,7 @@
lib/DateTime/Format/Natural/Base.pm
lib/DateTime/Format/Natural/Compat.pm
lib/DateTime/Format/Natural/Duration.pm
+lib/DateTime/Format/Natural/Formatted.pm
lib/DateTime/Format/Natural/Helpers.pm
lib/DateTime/Format/Natural/Lang/Base.pm
lib/DateTime/Format/Natural/Lang/EN.pm
@@ -27,5 +28,6 @@
t/08-parse_failure.t
t/09-regression.t
t/10-state.t
+t/11-trace.t
t/pod-coverage.t
t/pod.t
Modified: branches/upstream/libdatetime-format-natural-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/META.yml?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/META.yml (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/META.yml Wed Jan 13 22:41:09 2010
@@ -1,6 +1,6 @@
---
name: DateTime-Format-Natural
-version: 0.82
+version: 0.83
author:
- 'Steven Schubiger <schubiger at cpan.org>'
abstract: Create machine readable date/time with natural parsing logic
@@ -29,7 +29,7 @@
provides:
DateTime::Format::Natural:
file: lib/DateTime/Format/Natural.pm
- version: 0.82
+ version: 0.83
DateTime::Format::Natural::Base:
file: lib/DateTime/Format/Natural/Base.pm
version: 1.31
@@ -38,22 +38,25 @@
version: 0.06
DateTime::Format::Natural::Duration:
file: lib/DateTime/Format/Natural/Duration.pm
- version: 0.03
+ version: 0.04
+ DateTime::Format::Natural::Formatted:
+ file: lib/DateTime/Format/Natural/Formatted.pm
+ version: 0.01
DateTime::Format::Natural::Helpers:
file: lib/DateTime/Format/Natural/Helpers.pm
- version: 0.04
+ version: 0.05
DateTime::Format::Natural::Lang::Base:
file: lib/DateTime/Format/Natural/Lang/Base.pm
version: 1.03
DateTime::Format::Natural::Lang::EN:
file: lib/DateTime/Format/Natural/Lang/EN.pm
- version: 1.28
+ version: 1.29
DateTime::Format::Natural::Test:
file: lib/DateTime/Format/Natural/Test.pm
version: 0.04
DateTime::Format::Natural::Utils:
file: lib/DateTime/Format/Natural/Utils.pm
- version: 0.02
+ version: 0.03
DateTime::Format::Natural::Wrappers:
file: lib/DateTime/Format/Natural/Wrappers.pm
version: 0.02
Modified: branches/upstream/libdatetime-format-natural-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/README?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/README (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/README Wed Jan 13 22:41:09 2010
@@ -21,6 +21,8 @@
} else {
warn $parser->error;
}
+
+ @traces = $parser->trace;
DESCRIPTION
`DateTime::Format::Natural' takes a string with a human readable
@@ -100,8 +102,9 @@
trace
- Returns a trace of methods which were called within the Base class and a
- summary how often certain units have been modified.
+ Returns one or more strings with traces of methods which were called
+ within the Base class and a summary how often certain units have been
+ modified. More than one string is commonly returned for durations.
GRAMMAR
The grammar handling has been rewritten to be easily extendable and
@@ -114,6 +117,17 @@
EXAMPLES
See the classes `DateTime::Format::Natural::Lang::[language_code]' for a
overview of currently valid input.
+
+BUGS & CAVEATS
+ `parse_datetime()'/`parse_datetime_duration()' always return one or more
+ DateTime objects regardless whether the parse was successful or not. In
+ case no valid expression was found or a failure occurred, an unaltered
+ DateTime object with its initial values (most often the "current" now)
+ is likely to be returned. It is therefore recommended to use `success()'
+ to assert that the parse did succeed (at least, for common uses),
+ otherwise the absence of a parse failure cannot be guaranteed.
+
+ `parse_datetime()' is not capable of handling durations.
CREDITS
Thanks to Tatsuhiko Miyagawa for the initial inspiration. See Miyagawa's
Modified: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural.pm?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural.pm (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural.pm Wed Jan 13 22:41:09 2010
@@ -5,6 +5,7 @@
use base qw(
DateTime::Format::Natural::Base
DateTime::Format::Natural::Duration
+ DateTime::Format::Natural::Formatted
DateTime::Format::Natural::Helpers
);
use boolean qw(true false);
@@ -16,7 +17,7 @@
use Scalar::Util qw(blessed);
use Storable qw(dclone);
-our $VERSION = '0.82';
+our $VERSION = '0.83';
validation_options(
on_fail => sub
@@ -137,93 +138,27 @@
my $date_string = $self->{Date_string};
$date_string =~ tr/,//d;
- my @count = $date_string =~ m![-./]!g;
- my %count; $count{$_}++ foreach @count;
+ my ($formatted) = $date_string =~ m!^((?:\d+?[-./])+ (?:\d+?)) \b!x;
+
+ my %count;
+ if (defined $formatted) {
+ my @count = $formatted =~ m![-./]!g;
+ $count{$_}++ foreach @count;
+ }
$self->{tokens} = [];
+ $self->{traces} = [];
if (scalar keys %count == 1 && $count{(keys %count)[0]} == 2) {
- if ($date_string =~ /^\S+\b \s+ \b\S+/x) {
- ($date_string, @{$self->{tokens}}) = split /\s+/, $date_string;
- $self->{count}{tokens} = 1 + @{$self->{tokens}};
- }
- else {
- $self->{count}{tokens} = 1;
- }
-
- my $separator = quotemeta((keys %count)[0]);
- my @chunks = split /$separator/, $date_string;
-
- my $i = 0;
- my %length = map { length $_ => $i++ } @chunks;
-
- my $format = $self->{Format};
-
- if (exists $length{4}) {
- $format = join $separator,
- ($length{4} == 0
- ? qw(yyyy mm dd)
- : ($format =~ /^m/
- ? qw(mm dd yyyy)
- : qw(dd mm yyyy)
- )
- );
- }
- else {
- $separator = do { local $_ = $format;
- tr/a-zA-Z//d;
- tr/a-zA-Z//cs;
- quotemeta; };
- }
-
- my @separated_order = split /$separator/, $format;
- my $separated_index = 0;
-
- my $separated_indices = { map { substr($_, 0, 1) => $separated_index++ } @separated_order };
-
- my @bits = split /$separator/, $date_string;
-
- my $century = $self->{datetime}
- ? int($self->{datetime}->year / 100)
- : substr((localtime)[5] + 1900, 0, 2);
-
- my ($day, $month, $year) = map { $bits[$separated_indices->{$_}] } qw(d m y);
-
- if (not defined $day && defined $month && defined $year) {
- $self->_set_failure;
- $self->_set_error("('format' parameter invalid)");
- return $self->_get_datetime_object;
- }
-
- if (length $year == 2) { $year = "$century$year" };
-
- unless ($self->_check_date($year, $month, $day)) {
- $self->_set_failure;
- $self->_set_error("(invalid date)");
- return $self->_get_datetime_object;
- }
-
- $self->{datetime}->set(
- year => $year,
- month => $month,
- day => $day,
- );
- $self->{datetime}->truncate(to => 'day');
-
- $self->_set_valid_exp;
-
- if (@{$self->{tokens}}) {
- $self->{count}{tokens}--;
- $self->_unset_valid_exp;
- $self->_process;
- }
-
- if ($self->{duration}) {
- %{$self->{formatted}} = (
- year => $year,
- month => $month,
- day => $day,
- );
+ my $dt = $self->_parse_formatted_ymd($date_string, \%count);
+ return $dt if blessed($dt);
+ }
+ elsif (scalar keys %count == 1 && $count{(keys %count)[0]} == 1 && (keys %count)[0] eq '/') {
+ my $dt = $self->_parse_formatted_md($date_string);
+ return $dt if blessed($dt);
+
+ if ($self->{Prefer_future}) {
+ $self->_advance_future(qw(md));
}
}
else {
@@ -232,6 +167,11 @@
$self->{count}{tokens} = @{$self->{tokens}};
$self->_process;
+ }
+
+ my $trace = $self->_trace_string;
+ if (defined $trace) {
+ @{$self->{traces}} = $trace;
}
return $self->_get_datetime_object;
@@ -276,15 +216,11 @@
}
};
- unless ($self->{running_tests}) {
- if (exists $self->{formatted}) {
- $set_datetime->('new', {
- map { $_ => $self->{formatted}{$_} } qw(year month day)
- });
- }
- else {
- $set_datetime->('now', {});
- }
+ if ($self->{running_tests}) {
+ $self->{datetime} = $self->{datetime_test}->clone;
+ }
+ else {
+ $set_datetime->('now', {});
}
$self->_init_vars;
@@ -303,7 +239,7 @@
$self->_params_init(@_, { string => \$duration_string });
my $timespan_sep = $self->{data}->__timespan('literal');
- my @date_strings = $duration_string =~ /$timespan_sep/i
+ my @date_strings = $duration_string =~ /\b $timespan_sep \b/ix
? do { $self->{duration} = true;
split /\s+ $timespan_sep \s+/ix, $duration_string }
: do { $self->{duration} = false;
@@ -312,7 +248,7 @@
$self->_pre_duration(\@date_strings);
$self->{state} = {};
- my @queue;
+ my (@queue, @traces);
foreach my $date_string (@date_strings) {
push @queue, $self->parse_datetime($date_string);
$self->_save_state(
@@ -320,6 +256,9 @@
failure => $self->_get_failure,
error => $self->_get_error,
);
+ if (@{$self->{traces}}) {
+ push @traces, $self->{traces}[0];
+ }
}
$self->_post_duration(\@queue);
@@ -329,6 +268,7 @@
delete $self->{$member};
}
+ @{$self->{traces}} = @traces;
$self->{Input_string} = $duration_string;
return @queue;
@@ -357,9 +297,7 @@
{
my $self = shift;
- return join "\n", @{$self->{trace}},
- map { my $unit = $_; "$unit: $self->{modified}{$unit}" }
- keys %{$self->{modified}};
+ return @{$self->{traces}};
}
sub _process
@@ -438,8 +376,8 @@
? $regex_stack{$index}
: ${$self->_token($index)};
}
- my $meth = 'SUPER::'.$expression->[5]->[$i];
- $self->$meth(@values, $expression->[4]->[$i++]);
+ my $worker = "SUPER::$expression->[5]->[$i]";
+ $self->$worker(@values, $expression->[4]->[$i++]);
}
%opts = %{$expression->[6]};
last PARSE;
@@ -462,44 +400,52 @@
if ($self->{Prefer_future} &&
(exists $opts{prefer_future} && $opts{prefer_future})
) {
- my %modified = map { $_ => true } keys %{$self->{modified}};
- my $token_contains = sub
- {
- my ($identifier) = @_;
- return any {
- my $data = $_;
- any {
- my $token = $_;
- $token =~ /$data/i;
- } @{$self->{tokens}}
- } @{$self->{data}->{$identifier}};
- };
-
- if ((all { /^(?:second|minute|hour)$/ } keys %modified)
- && (exists $self->{modified}{hour} && $self->{modified}{hour} == 1)
- && (exists $self->{modified}{minute} && $self->{modified}{minute} == 1)
- && $self->{datetime}->hour < DateTime->now(time_zone => $self->{Time_zone})->hour
- ) {
- $self->{postprocess}{day} = 1;
- }
- elsif ($token_contains->('weekdays_all')
- && (exists $self->{modified}{day} && $self->{modified}{day} == 1)
- && ($self->_Day_of_Week($self->{datetime}->year, $self->{datetime}->month, $self->{datetime}->day)
- < DateTime->now(time_zone => $self->{Time_zone})->wday)
- ) {
- $self->{postprocess}{day} = 7;
- }
- elsif ($token_contains->('months_all')
- && (all { /^(?:day|month)$/ } keys %modified)
- && (exists $self->{modified}{month} && $self->{modified}{month} == 1)
- && (exists $self->{modified}{day}
- ? $self->{modified}{day} == 1
- ? true : false
- : true)
- && ($self->{datetime}->day_of_year < DateTime->now->day_of_year)
- ) {
- $self->{postprocess}{year} = 1;
- }
+ $self->_advance_future;
+ }
+}
+
+sub _advance_future
+{
+ my $self = shift;
+ my %advance = map { $_ => true } @_;
+
+ my %modified = map { $_ => true } keys %{$self->{modified}};
+ my $token_contains = sub
+ {
+ my ($identifier) = @_;
+ return any {
+ my $data = $_;
+ any {
+ my $token = $_;
+ $token =~ /$data/i;
+ } @{$self->{tokens}}
+ } @{$self->{data}->{$identifier}};
+ };
+
+ if ((all { /^(?:second|minute|hour)$/ } keys %modified)
+ && (exists $self->{modified}{hour} && $self->{modified}{hour} == 1)
+ && (exists $self->{modified}{minute} && $self->{modified}{minute} == 1)
+ && $self->{datetime}->hour < DateTime->now(time_zone => $self->{Time_zone})->hour
+ ) {
+ $self->{postprocess}{day} = 1;
+ }
+ elsif ($token_contains->('weekdays_all')
+ && (exists $self->{modified}{day} && $self->{modified}{day} == 1)
+ && ($self->_Day_of_Week($self->{datetime}->year, $self->{datetime}->month, $self->{datetime}->day)
+ < DateTime->now(time_zone => $self->{Time_zone})->wday)
+ ) {
+ $self->{postprocess}{day} = 7;
+ }
+ elsif (($token_contains->('months_all') || $advance{md})
+ && (all { /^(?:day|month)$/ } keys %modified)
+ && (exists $self->{modified}{month} && $self->{modified}{month} == 1)
+ && (exists $self->{modified}{day}
+ ? $self->{modified}{day} == 1
+ ? true : false
+ : true)
+ && ($self->{datetime}->day_of_year < DateTime->now->day_of_year)
+ ) {
+ $self->{postprocess}{year} = 1;
}
}
@@ -558,7 +504,7 @@
my $self = shift;
my ($time, $tz) = @_;
- $self->{datetime} = DateTime->new(
+ $self->{datetime_test} = DateTime->new(
time_zone => $tz || 'floating',
%$time,
);
@@ -593,6 +539,8 @@
warn $parser->error;
}
+ @traces = $parser->trace;
+
=head1 DESCRIPTION
C<DateTime::Format::Natural> takes a string with a human readable date/time and creates a
@@ -687,8 +635,9 @@
=head2 trace
-Returns a trace of methods which were called within the Base class and
-a summary how often certain units have been modified.
+Returns one or more strings with traces of methods which were called within
+the Base class and a summary how often certain units have been modified.
+More than one string is commonly returned for durations.
=head1 GRAMMAR
@@ -702,6 +651,18 @@
See the classes C<DateTime::Format::Natural::Lang::[language_code]> for a
overview of currently valid input.
+
+=head1 BUGS & CAVEATS
+
+C<parse_datetime()>/C<parse_datetime_duration()> always return one or more
+DateTime objects regardless whether the parse was successful or not. In
+case no valid expression was found or a failure occurred, an unaltered
+DateTime object with its initial values (most often the "current" now) is
+likely to be returned. It is therefore recommended to use C<success()> to
+assert that the parse did succeed (at least, for common uses), otherwise
+the absence of a parse failure cannot be guaranteed.
+
+C<parse_datetime()> is not capable of handling durations.
=head1 CREDITS
Modified: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Duration.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Duration.pm?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Duration.pm (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Duration.pm Wed Jan 13 22:41:09 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
sub _pre_duration
{
@@ -15,9 +15,14 @@
if ($duration->{for}->($date_strings)) {
$self->{insert} = $self->parse_datetime('now');
}
- elsif ($duration->{first_last}->($date_strings)) {
+ elsif ($duration->{first_to_last}->($date_strings)) {
if (my ($complete) = $date_strings->[1] =~ /^\S+? \s+ (.*)/x) {
$date_strings->[0] .= " $complete";
+ }
+ }
+ elsif ($duration->{date_time_to_time}->($date_strings)) {
+ if (my ($complete) = $date_strings->[0] =~ /^(\S+?) \s+ .*/x) {
+ $date_strings->[1] = "$complete $date_strings->[1]";
}
}
}
Added: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Formatted.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Formatted.pm?rev=50898&op=file
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Formatted.pm (added)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Formatted.pm Wed Jan 13 22:41:09 2010
@@ -1,0 +1,171 @@
+package DateTime::Format::Natural::Formatted;
+
+use strict;
+use warnings;
+use boolean qw(true);
+
+our $VERSION = '0.01';
+
+sub _parse_formatted_ymd
+{
+ my $self = shift;
+ my ($date_string, $count) = @_;
+
+ my $date = $self->_split_formatted($date_string);
+
+ my $separator = quotemeta((keys %$count)[0]);
+ my @chunks = split /$separator/, $date;
+
+ my $i = 0;
+ my %length = map { length $_ => $i++ } @chunks;
+
+ my $format = $self->{Format};
+
+ if (exists $length{4}) {
+ $format = join $separator,
+ ($length{4} == 0
+ ? qw(yyyy mm dd)
+ : ($format =~ /^m/
+ ? qw(mm dd yyyy)
+ : qw(dd mm yyyy)
+ )
+ );
+ }
+ else {
+ $separator = do { local $_ = $format;
+ tr/a-zA-Z//d;
+ tr/a-zA-Z//cs;
+ quotemeta; };
+ }
+
+ my @separated_order = split /$separator/, $format;
+
+ my ($d, $m, $y) = do {
+ my %f = map { substr($_, 0, 1) => true } @separated_order;
+ ($f{d}, $f{m}, $f{y});
+ };
+ unless (@separated_order == 3 and ($d && $m && $y)) {
+ $self->_set_failure;
+ $self->_set_error("('format' parameter invalid)");
+ return $self->_get_datetime_object;
+ }
+
+ my $separated_index = 0;
+ my $separated_indices = { map { substr($_, 0, 1) => $separated_index++ } @separated_order };
+
+ my @bits = split /$separator/, $date;
+
+ my $century = $self->{datetime}
+ ? int($self->{datetime}->year / 100)
+ : substr((localtime)[5] + 1900, 0, 2);
+
+ my ($day, $month, $year) = map $bits[$separated_indices->{$_}], qw(d m y);
+
+ if (length $year == 2) { $year = "$century$year" };
+
+ unless ($self->_check_date($year, $month, $day)) {
+ $self->_set_failure;
+ $self->_set_error("(invalid date)");
+ return $self->_get_datetime_object;
+ }
+
+ $self->_set(
+ year => $year,
+ month => $month,
+ day => $day,
+ );
+ $self->{datetime}->truncate(to => 'day');
+ $self->_set_valid_exp;
+
+ $self->_process_tokens;
+
+ return undef;
+}
+
+sub _parse_formatted_md
+{
+ my $self = shift;
+ my ($date_string) = @_;
+
+ my $date = $self->_split_formatted($date_string);
+
+ my ($month, $day) = split /\//, $date;
+
+ unless ($self->_check_date($self->{datetime}->year, $month, $day)) {
+ $self->_set_failure;
+ $self->_set_error("(invalid date)");
+ return $self->_get_datetime_object;
+ }
+
+ $self->_set(
+ month => $month,
+ day => $day,
+ );
+ $self->{datetime}->truncate(to => 'day');
+ $self->_set_valid_exp;
+
+ $self->_process_tokens;
+
+ return undef;
+}
+
+sub _split_formatted
+{
+ my $self = shift;
+ my ($date_string) = @_;
+
+ my $date;
+ if ($date_string =~ /^\S+\b \s+ \b\S+/x) {
+ ($date, @{$self->{tokens}}) = split /\s+/, $date_string;
+ $self->{count}{tokens} = 1 + @{$self->{tokens}};
+ }
+ else {
+ $self->{count}{tokens} = 1;
+ }
+
+ return defined $date ? $date : $date_string;
+}
+
+sub _process_tokens
+{
+ my $self = shift;
+
+ if (@{$self->{tokens}}) {
+ $self->{count}{tokens}--;
+ $self->_unset_valid_exp;
+ $self->_process;
+ }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+DateTime::Format::Natural::Formatted - Processing of formatted dates
+
+=head1 SYNOPSIS
+
+ Please see the DateTime::Format::Natural documentation.
+
+=head1 DESCRIPTION
+
+The C<DateTime::Format::Natural::Formatted> class contains methods
+to parse formatted dates.
+
+=head1 SEE ALSO
+
+L<DateTime::Format::Natural>
+
+=head1 AUTHOR
+
+Steven Schubiger <schubiger at cpan.org>
+
+=head1 LICENSE
+
+This program is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://dev.perl.org/licenses/>
+
+=cut
Modified: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Helpers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Helpers.pm?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Helpers.pm (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Helpers.pm Wed Jan 13 22:41:09 2010
@@ -10,7 +10,8 @@
our ($VERSION, @EXPORT_OK, %flag);
-$VERSION = '0.04';
+$VERSION = '0.05';
+ at EXPORT_OK = qw(%flag);
my @flags = (
{ weekday_name => REAL_FLAG },
@@ -29,8 +30,6 @@
%flag = map { (keys %$_)[0] => $i++ } @flags;
}
- at EXPORT_OK = qw(%flag);
-
sub _helper
{
my $self = shift;
@@ -39,8 +38,8 @@
foreach my $flag (@$flags) {
my $name = (keys %{$flags[$flag]})[0];
if ($flags[$flag]->{$name}) {
- my $meth = '_' . $name;
- $self->$meth(\$string);
+ my $helper = "_$name";
+ $self->$helper(\$string);
}
else {
$string = $self->{data}->{conversion}->{$name}->{lc $string};
Modified: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Lang/EN.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Lang/EN.pm?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Lang/EN.pm (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Lang/EN.pm Wed Jan 13 22:41:09 2010
@@ -9,7 +9,7 @@
use DateTime::Format::Natural::Helpers qw(%flag);
-our $VERSION = '1.28';
+our $VERSION = '1.29';
our (%init,
%timespan,
@@ -90,11 +90,21 @@
return (@$date_strings == 1
&& $date_strings->[0] =~ /^for\s+/i);
},
- first_last => sub {
+ first_to_last => sub {
my ($date_strings) = @_;
return (@$date_strings == 2
&& $date_strings->[0] =~ /^first$/i
&& $date_strings->[1] =~ /^last\s+/i);
+ },
+ date_time_to_time => sub {
+ my ($date_strings) = @_;
+
+ my $date = qr!(?:\d{1,4}) (?:[-./]\d{1,4}){0,2}!x;
+ my $time = qr!(?:\d{1,2}) (?:\:\d{2}){0,2}!x;
+
+ return (@$date_strings == 2
+ && $date_strings->[0] =~ /^$date \s+ $time$/x
+ && $date_strings->[1] =~ /^$time$/);
},
);
}
@@ -3578,7 +3588,12 @@
Monday to Friday
1 April to 31 August
+ 1999-12-31 to tomorrow
+ now to 2010-01-01
2009-03-10 9:00 to 11:00
+ 1/3 to 2/3
+ 2/3 to in 1 week
+ 3/3 21:00 to in 5 days
first day of 2009 to last day of 2009
first day of may to last day of may
first to last day of 2008
@@ -3607,6 +3622,8 @@
jan 3 2010
3 jan 2000
27/5/1979
+ 1/3
+ 1/3 16:00
4:00
17:00
3:20:00
Modified: branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Utils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Utils.pm?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Utils.pm (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/lib/DateTime/Format/Natural/Utils.pm Wed Jan 13 22:41:09 2010
@@ -4,7 +4,7 @@
use warnings;
use boolean qw(true false);
-our $VERSION = '0.02';
+our $VERSION = '0.03';
sub _valid_date
{
@@ -52,6 +52,26 @@
}
}
+sub _trace_string
+{
+ my $self = shift;
+
+ my ($trace, $modified) = map $self->{$_}, qw(trace modified);
+
+ $trace ||= [];
+ $modified ||= {};
+
+ return undef unless (@$trace || %$modified);
+
+ my $i;
+ my %order = map { $_ => $i++ } qw(second minute hour day week month year);
+
+ return join "\n", @$trace,
+ map { my $unit = $_; "$unit: $modified->{$unit}" }
+ sort { $order{$a} <=> $order{$b} }
+ keys %$modified;
+}
+
1;
__END__
Modified: branches/upstream/libdatetime-format-natural-perl/current/scripts/dateparse
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/scripts/dateparse?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/scripts/dateparse (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/scripts/dateparse Wed Jan 13 22:41:09 2010
@@ -120,18 +120,18 @@
}
my @dt = $parser->parse_datetime_duration(string => $input);
+ my @traces = $parser->trace;
if ($parser->success) {
foreach my $dt (@dt) {
printf("%02d.%02d.%4d %02d:%02d:%02d\n", map $dt->$_, qw(day month year hour min sec));
+ if ($trace && @traces) {
+ print shift @traces, "\n";
+ }
}
}
else {
warn $parser->error, "\n";
- }
-
- if ($trace) {
- print $parser->trace, "\n";
}
}
}
Modified: branches/upstream/libdatetime-format-natural-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/t/00-load.t?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/t/00-load.t (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/t/00-load.t Wed Jan 13 22:41:09 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More tests => 11;
BEGIN
{
@@ -12,6 +12,7 @@
DateTime::Format::Natural::Base
DateTime::Format::Natural::Compat
DateTime::Format::Natural::Duration
+ DateTime::Format::Natural::Formatted
DateTime::Format::Natural::Helpers
DateTime::Format::Natural::Lang::Base
DateTime::Format::Natural::Lang::EN
Modified: branches/upstream/libdatetime-format-natural-perl/current/t/02-parse_format.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/t/02-parse_format.t?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/t/02-parse_format.t (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/t/02-parse_format.t Wed Jan 13 22:41:09 2010
@@ -13,9 +13,11 @@
{ '05/27/79' => [ '27.05.2079 00:00:00', 'mm/dd/yy' ] },
{ '1979-05-27' => [ '27.05.1979 00:00:00', 'yyyy-mm-dd' ] },
{ '1979-05-27 21:09:14' => [ '27.05.1979 21:09:14', 'yyyy-mm-dd' ] },
+ { '1/3' => [ '03.01.2006 00:00:00', undef ] },
+ { '1/3 16:00' => [ '03.01.2006 16:00:00', undef ] },
);
-_run_tests(5, [ [ \@specific ] ], \&compare);
+_run_tests(7, [ [ \@specific ] ], \&compare);
sub compare
{
@@ -30,7 +32,9 @@
{
my ($string, $result, $format) = @_;
- my $parser = DateTime::Format::Natural->new(format => $format);
+ my %args = defined $format ? (format => $format) : ();
+
+ my $parser = DateTime::Format::Natural->new(%args);
$parser->_set_datetime(\%time);
my $dt = $parser->parse_datetime($string);
Modified: branches/upstream/libdatetime-format-natural-perl/current/t/04-parse_durations.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/t/04-parse_durations.t?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/t/04-parse_durations.t (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/t/04-parse_durations.t Wed Jan 13 22:41:09 2010
@@ -22,7 +22,12 @@
);
my @relative = (
+ { '1999-12-31 to tomorrow' => [ '31.12.1999 00:00:00', '25.11.2006 00:00:00' ] },
+ { 'now to 2010-01-01' => [ '24.11.2006 01:13:08', '01.01.2010 00:00:00' ] },
{ '2009-03-10 9:00 to 11:00' => [ '10.03.2009 09:00:00', '10.03.2009 11:00:00' ] },
+ { '1/3 to 2/3' => [ '03.01.2006 00:00:00', '03.02.2006 00:00:00' ] },
+ { '2/3 to in 1 week' => [ '03.02.2006 00:00:00', '01.12.2006 01:13:08' ] },
+ { '3/3 21:00 to in 5 days' => [ '03.03.2006 21:00:00', '29.11.2006 01:13:08' ] },
{ 'for 4 seconds' => [ '24.11.2006 01:13:08', '24.11.2006 01:13:12' ] },
{ 'for 4 minutes' => [ '24.11.2006 01:13:08', '24.11.2006 01:17:08' ] },
{ 'for 4 hours' => [ '24.11.2006 01:13:08', '24.11.2006 05:13:08' ] },
@@ -32,7 +37,7 @@
{ 'for 4 years' => [ '24.11.2006 01:13:08', '24.11.2010 01:13:08' ] },
);
-_run_tests(15, [ [ \@absolute ], [ \@combined ], [ \@relative ] ], \&compare);
+_run_tests(20, [ [ \@absolute ], [ \@combined ], [ \@relative ] ], \&compare);
sub compare
{
Modified: branches/upstream/libdatetime-format-natural-perl/current/t/06-parse_prefer_future.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/t/06-parse_prefer_future.t?rev=50898&op=diff
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/t/06-parse_prefer_future.t (original)
+++ branches/upstream/libdatetime-format-natural-perl/current/t/06-parse_prefer_future.t Wed Jan 13 22:41:09 2010
@@ -49,7 +49,12 @@
{ 'monday at 03:00 pm' => '27.11.2006 15:00:00' },
);
-_run_tests(26, [ [ \@simple ], [ \@combined ] ], \&compare);
+my @formatted = (
+ { '1/3' => '03.01.2007 00:00:00' },
+ { '12/24' => '24.12.2006 00:00:00' },
+);
+
+_run_tests(28, [ [ \@simple ], [ \@combined ], [ \@formatted ] ], \&compare);
sub compare
{
Added: branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t?rev=50898&op=file
==============================================================================
--- branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t (added)
+++ branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t Wed Jan 13 22:41:09 2010
@@ -1,0 +1,50 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use DateTime::Format::Natural;
+use Test::More tests => 5;
+
+my $parser = DateTime::Format::Natural->new;
+my $stringify = sub { local $" = "\n"; "@_\n" };
+
+{
+ my $string;
+
+ $string = 'now';
+ $parser->parse_datetime($string);
+ is($stringify->(($parser->trace)[0]), <<'EOT', $string);
+DateTime::Format::Natural::Base::_no_op
+EOT
+ $string = 'yesterday 3 years ago';
+ $parser->parse_datetime($string);
+ is($stringify->(($parser->trace)[0]), <<'EOT', $string);
+DateTime::Format::Natural::Base::_unit_variant
+DateTime::Format::Natural::Base::_ago_variant
+day: 1
+year: 1
+EOT
+ $string = 'monday to friday';
+ $parser->parse_datetime_duration($string);
+ is($stringify->($parser->trace), <<'EOT', $string);
+DateTime::Format::Natural::Base::_weekday
+day: 1
+DateTime::Format::Natural::Base::_weekday
+day: 1
+EOT
+}
+
+{
+ my ($string, @trace);
+
+ $string = 'bogus';
+ $parser->parse_datetime($string);
+ @trace = $parser->trace;
+ ok(!@trace, 'empty trace for parse_datetime');
+
+ $string = 'bogus to bogus';
+ $parser->parse_datetime_duration($string);
+ @trace = $parser->trace;
+ ok(!@trace, 'empty trace for parse_datetime_duration');
+}
Propchange: branches/upstream/libdatetime-format-natural-perl/current/t/11-trace.t
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list