[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