[Bps-public-commit] Net-IMAP-Server branch, master, updated. 1.20-9-gf88bd18
Alex M Vandiver
alexmv at bestpractical.com
Thu Jul 9 14:44:14 EDT 2009
The branch, master has been updated
via f88bd18b9a50ac8501845229ea343756b3d91002 (commit)
via e980e83f6d32d021178a203a7a97fba8e8c7fe22 (commit)
via 72d3eace05d6f6f47634f1cdcb71fea664774655 (commit)
via 03aac44a46286867f31b845deb1ba29870e0fbf6 (commit)
via 5fc790e7cc225f5d3a20fb4c7b59a4923d703ce5 (commit)
from 03ace00b7b62f985702448b45f960bb6098e8370 (commit)
Summary of changes:
Makefile.PL | 1 +
lib/Net/IMAP/Server/Command/Append.pm | 4 +-
lib/Net/IMAP/Server/Command/Search.pm | 47 +++++++++++++++---
lib/Net/IMAP/Server/Message.pm | 87 +++++++++++++++++++++++++++++++--
4 files changed, 125 insertions(+), 14 deletions(-)
- Log -----------------------------------------------------------------
commit 5fc790e7cc225f5d3a20fb4c7b59a4923d703ce5
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jul 9 14:38:19 2009 -0400
Better error message on unknown SEARCH token
diff --git a/lib/Net/IMAP/Server/Command/Search.pm b/lib/Net/IMAP/Server/Command/Search.pm
index 8633e46..edf058f 100644
--- a/lib/Net/IMAP/Server/Command/Search.pm
+++ b/lib/Net/IMAP/Server/Command/Search.pm
@@ -149,7 +149,7 @@ sub filter {
};
$filters = $intersection;
} else {
- return $self->bad_command("Unknown command: $token");
+ return $self->bad_command("Unknown search token: $token");
}
while (@stack and (@{$filters} == $stack[0][1] or ($stack[0][3] and not @tokens))) {
commit 03aac44a46286867f31b845deb1ba29870e0fbf6
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jul 9 14:41:24 2009 -0400
Add caching of "start of the day in utc" for searching
diff --git a/lib/Net/IMAP/Server/Command/Append.pm b/lib/Net/IMAP/Server/Command/Append.pm
index e1b5460..19d83a9 100644
--- a/lib/Net/IMAP/Server/Command/Append.pm
+++ b/lib/Net/IMAP/Server/Command/Append.pm
@@ -36,10 +36,10 @@ sub run {
}
if (@options and grep {not ref $_} @options) {
my ($time) = grep {not ref $_} @options;
- my $parser = DateTime::Format::Strptime->new(pattern => "%e-%b-%Y %T %z");
+ my $parser = $msg->INTERNALDATE_PARSER;
my $dt = $parser->parse_datetime($time);
return $self->bad_command("Invalid date") unless $dt;
- $msg->internaldate( $parser->format_datetime($dt) );
+ $msg->internaldate( $dt );
}
$self->connection->previous_exists( $self->connection->previous_exists + 1 )
diff --git a/lib/Net/IMAP/Server/Message.pm b/lib/Net/IMAP/Server/Message.pm
index d054316..3849418 100644
--- a/lib/Net/IMAP/Server/Message.pm
+++ b/lib/Net/IMAP/Server/Message.pm
@@ -10,6 +10,9 @@ use Email::MIME::ContentType;
use Regexp::Common qw/balanced/;
use DateTime;
+use DateTime::Format::Strptime;
+use constant INTERNALDATE_PARSER => DateTime::Format::Strptime->new(pattern => "%e-%b-%Y %T %z");
+
# Canonical capitalization
my %FLAGS;
$FLAGS{ lc $_ } = $_ for qw(\Answered \Flagged \Deleted \Seen \Draft);
@@ -17,7 +20,7 @@ $FLAGS{ lc $_ } = $_ for qw(\Answered \Flagged \Deleted \Seen \Draft);
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(
- qw(sequence mailbox uid _flags mime internaldate expunged));
+ qw(sequence mailbox uid _flags mime expunged));
=head1 NAME
@@ -35,7 +38,7 @@ sub new {
my $class = shift;
my $self = bless {}, $class;
$self->mime( Email::MIME->new(@_) ) if @_;
- $self->internaldate( DateTime->now->strftime("%e-%b-%Y %T %z") );
+ $self->internaldate( DateTime->now( time_zone => 'local' ) );
$self->_flags( {} );
return $self;
}
@@ -60,11 +63,45 @@ L<Net::IMAP::Server::Connection/sequence>.
Gets or sets the UID of the message. This, paired with the name and
UIDVALIDITY of its mailbox, is a unique designator of the message.
-=head2 internaldate [STRING]
+=head2 internaldate [STRING or DATETIME]
Gets or sets the string representing when the message was received by
the server. According to RFC specification, this must be formatted as
-C<01-Jan-2008 15:42 -0500>.
+C<01-Jan-2008 15:42:00 -0500> if it is a C<STRING>.
+
+=cut
+
+sub internaldate {
+ my $self = shift;
+ return $self->{internaldate} unless @_;
+ my $value = shift;
+
+ if (ref $value) {
+ $self->{internaldate} = $value->strftime("%e-%b-%Y %T %z");
+ } else {
+ $self->{internaldate} = $value;
+ $value = $self->INTERNALDATE_PARSER->parse_datetime($value);
+ }
+ $value->truncate( to => "day" );
+ $value->set_time_zone( "floating" );
+ $value->set_time_zone( "UTC" );
+ $self->{epoch_day_utc} = $value->epoch;
+ return $self->{internaldate};
+}
+
+=head2 epoch_day_utc
+
+Returns the epoch time of the L</internaldate>, ignoring times and
+time zones. This is almost certainly only useful for C<SEARCH BEFORE>
+and friends.
+
+=cut
+
+sub epoch_day_utc {
+ my $self = shift;
+ return $self->{epoch_day_utc};
+}
+
=head2 expunge
commit 72d3eace05d6f6f47634f1cdcb71fea664774655
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jul 9 14:41:59 2009 -0400
Add extraction of "start of the Date: header in utc" for searching
diff --git a/Makefile.PL b/Makefile.PL
index e3facee..4ca8034 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,6 +9,7 @@ license('perl');
requires('Class::Accessor');
requires('Coro');
requires('DateTime');
+requires('DateTime::Format::Mail');
requires('DateTime::Format::Strptime');
requires('Email::Address');
requires('Email::MIME' => 1.862);
diff --git a/lib/Net/IMAP/Server/Message.pm b/lib/Net/IMAP/Server/Message.pm
index 3849418..7a54f25 100644
--- a/lib/Net/IMAP/Server/Message.pm
+++ b/lib/Net/IMAP/Server/Message.pm
@@ -11,7 +11,9 @@ use Regexp::Common qw/balanced/;
use DateTime;
use DateTime::Format::Strptime;
+use DateTime::Format::Mail;
use constant INTERNALDATE_PARSER => DateTime::Format::Strptime->new(pattern => "%e-%b-%Y %T %z");
+use constant HEADERDATE_PARSER => DateTime::Format::Mail->new->loose;
# Canonical capitalization
my %FLAGS;
@@ -102,6 +104,43 @@ sub epoch_day_utc {
return $self->{epoch_day_utc};
}
+=head2 date
+
+Returns the Date header of the message, as a L<DateTime> object.
+Returns undef if the date cannot be parsed.
+
+=cut
+
+sub date {
+ my $self = shift;
+ my $date = $self->mime_header->header("Date");
+ return unless $date;
+
+ return eval {
+ $self->HEADERDATE_PARSER->parse_datetime(
+ $date
+ )
+ };
+}
+
+=head2 date_day_utc
+
+Similar to L</epoch_day_utc>, but for the L</date> header. That is,
+it returns the Date header, having stripped off the timezone and time.
+Returns undef if the Date header cannot be parsed.
+
+=cut
+
+sub date_day_utc {
+ my $self = shift;
+ my $date = $self->date;
+ return unless $date;
+
+ $date->truncate( to => "day" );
+ $date->set_time_zone( "floating" );
+ $date->set_time_zone( "UTC" );
+ return $date;
+}
=head2 expunge
commit e980e83f6d32d021178a203a7a97fba8e8c7fe22
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jul 9 14:42:39 2009 -0400
Add BEFORE, ON, SINCE, SENTBEFORE, SENTON, SENTSINC support to SEARCH
diff --git a/lib/Net/IMAP/Server/Command/Search.pm b/lib/Net/IMAP/Server/Command/Search.pm
index edf058f..bb3fe94 100644
--- a/lib/Net/IMAP/Server/Command/Search.pm
+++ b/lib/Net/IMAP/Server/Command/Search.pm
@@ -5,6 +5,7 @@ use strict;
use bytes;
use base qw/Net::IMAP::Server::Command/;
+use DateTime::Format::Strptime;
sub validate {
my $self = shift;
@@ -27,6 +28,8 @@ sub run {
$self->ok_completed;
}
+my $arg_parser = DateTime::Format::Strptime->new(pattern => "%e-%b-%Y");
+
sub filter {
my $self = shift;
my @tokens = [@_]; # This ref is intentional! It gets us the top-level AND
@@ -43,7 +46,12 @@ sub filter {
return $self->bad_command("Parse error") unless @tokens;
my $bcc = shift @tokens;
push @{$filters}, sub {$_[0]->mime->header("Bcc")||"" =~ /\Q$bcc\E/i};
- # BEFORE
+ } elsif ($token eq "BEFORE") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {$_[0]->epoch_day_utc < $parsed->epoch };
} elsif ($token eq "BODY") {
return $self->bad_command("Parse error") unless @tokens;
my $str = shift @tokens;
@@ -83,7 +91,12 @@ sub filter {
$filters = $negation;
} elsif ($token eq "OLD") {
push @{$filters}, sub {not $_[0]->has_flag('\Recent')};
- # ON
+ } elsif ($token eq "ON") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {$_[0]->epoch_day_utc >= $parsed->epoch and $_[0]->epoch_day_utc < $parsed->epoch + 60*60*24 };
} elsif ($token eq "OR") {
unshift @stack, [OR => 2 => $filters];
my $union = [];
@@ -93,10 +106,30 @@ sub filter {
push @{$filters}, sub {$_[0]->has_flag('\Recent')};
} elsif ($token eq "SEEN") {
push @{$filters}, sub {$_[0]->has_flag('\Seen')};
- # SENTBEFORE
- # SENTON
- # SENTSINCE
- # SINCE
+ } elsif ($token eq "SENTBEFORE") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch < $parsed->epoch; };
+ } elsif ($token eq "SENTON") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch >= $parsed->epoch and $e->epoch < $parsed->epoch + 60*60*24 };
+ } elsif ($token eq "SENTSINCE") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch >= $parsed->epoch };
+ } elsif ($token eq "SINCE") {
+ return $self->bad_command("Parse error") unless @tokens;
+ my $date = shift @tokens;
+ my $parsed = $arg_parser->parse_datetime($date);
+ return $self->bad_command("Bad date: $date") unless $parsed;
+ push @{$filters}, sub {$_[0]->epoch_day_utc >= $parsed->epoch }
} elsif ($token eq "SMALLER") {
return $self->bad_command("Parse error") unless @tokens;
my $size = shift @tokens;
commit f88bd18b9a50ac8501845229ea343756b3d91002
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jul 9 14:43:15 2009 -0400
Document Net::IMAP::Server::Message->expunged
diff --git a/lib/Net/IMAP/Server/Message.pm b/lib/Net/IMAP/Server/Message.pm
index 7a54f25..9682fad 100644
--- a/lib/Net/IMAP/Server/Message.pm
+++ b/lib/Net/IMAP/Server/Message.pm
@@ -157,7 +157,8 @@ sub expunge {
=head2 expunged
-=cut
+Returns true if the message has been marked as "to be expunged" by
+L</expunge>.
=head2 copy_allowed MAILBOX
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list