r40366 - in /trunk/libnet-imap-simple-perl: ./ debian/ inc/Net/IMAP/ inc/Net/IMAP/Server/ inc/Net/IMAP/Server/Command/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Tue Jul 21 03:29:57 UTC 2009


Author: jawnsy-guest
Date: Tue Jul 21 03:29:50 2009
New Revision: 40366

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=40366
Log:
new upstream version. need to test again.

Modified:
    trunk/libnet-imap-simple-perl/Changes
    trunk/libnet-imap-simple-perl/META.yml
    trunk/libnet-imap-simple-perl/Makefile.PL
    trunk/libnet-imap-simple-perl/Simple.pm
    trunk/libnet-imap-simple-perl/debian/changelog
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Append.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Search.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Uid.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Connection.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Mailbox.pm
    trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Message.pm
    trunk/libnet-imap-simple-perl/t/test_server.pm

Modified: trunk/libnet-imap-simple-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/Changes?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Changes (original)
+++ trunk/libnet-imap-simple-perl/Changes Tue Jul 21 03:29:50 2009
@@ -1,3 +1,10 @@
+1.1905: Mon Jul 20 2009
+   - I apparently need Class::Accessor installed for tests.
+     Pulling over all deps of the now included net-imap-server
+
+1.1904: Fri Jul 17 2009
+   - bestpractical's patch makes more sense than mine does
+
 1.1903: Fri Jul 17 2009
    - actually use the inc/ copy of net-imap-server
 

Modified: trunk/libnet-imap-simple-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/META.yml?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/META.yml (original)
+++ trunk/libnet-imap-simple-perl/META.yml Tue Jul 21 03:29:50 2009
@@ -1,17 +1,28 @@
 --- #YAML:1.0
 name:               Net-IMAP-Simple
-version:            1.1903
+version:            1.1905
 abstract:           ~
 author:
     - Paul Miller <jettero at cpan.org>
 license:            Perl Artistic
 distribution_type:  module
 configure_requires:
-    Coro:               0
-    Coro::EV:           0
-    DateTime:           0
-    IO::Socket::SSL:    0
-    Net::IMAP::Server:  0
+    Class::Accessor:      0
+    Coro:                 0
+    DateTime:             0
+    DateTime::Format::Mail:  0
+    DateTime::Format::Strptime:  0
+    Email::Address:       0
+    Email::MIME:          1.862
+    Email::MIME::ContentType:  0
+    Email::Simple:        1.999
+    Encode::IMAPUTF7:     0
+    MIME::Base64:         0
+    Net::Server::Coro:    0.3
+    Net::SSLeay:          0
+    Regexp::Common:       0
+    Test::More:           0
+    UNIVERSAL::require:   0
 build_requires:
     ExtUtils::MakeMaker:  0
 requires:

Modified: trunk/libnet-imap-simple-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/Makefile.PL?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Makefile.PL (original)
+++ trunk/libnet-imap-simple-perl/Makefile.PL Tue Jul 21 03:29:50 2009
@@ -24,7 +24,27 @@
         CONFIGURE_REQUIRES => {
             ( $ENV{TEST_AUTHOR}
                 || $ENV{AUTOMATED_TESTING} ? # thank you BinGOs
-                (map {($_=>0)} qw(DateTime IO::Socket::SSL Net::IMAP::Server Coro Coro::EV)) : ())
+
+                (
+                    'Class::Accessor'             => 0,
+                    'Coro'                        => 0,
+                    'DateTime'                    => 0,
+                    'DateTime::Format::Mail'      => 0,
+                    'DateTime::Format::Strptime'  => 0,
+                    'Email::Address'              => 0,
+                    'Email::MIME'                 => 1.862,
+                    'Email::MIME::ContentType'    => 0,
+                    'Email::Simple'               => 1.999,
+                    'Encode::IMAPUTF7'            => 0,
+                    'MIME::Base64'                => 0,
+                    'Net::SSLeay'                 => 0,
+                    'Net::Server::Coro'           => 0.3,
+                    'Regexp::Common'              => 0,
+                    'Test::More'                  => 0,
+                    'UNIVERSAL::require'          => 0,
+
+                ) : (),
+            )
         },
 
     ) : ()),

Modified: trunk/libnet-imap-simple-perl/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/Simple.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Simple.pm (original)
+++ trunk/libnet-imap-simple-perl/Simple.pm Tue Jul 21 03:29:50 2009
@@ -8,7 +8,7 @@
 use IO::Socket;
 use IO::Select;
 
-our $VERSION = "1.1903";
+our $VERSION = "1.1905";
 
 BEGIN {
     # I'd really rather the pause/cpan indexers miss this "package"

Modified: trunk/libnet-imap-simple-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/debian/changelog?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/debian/changelog (original)
+++ trunk/libnet-imap-simple-perl/debian/changelog Tue Jul 21 03:29:50 2009
@@ -1,4 +1,4 @@
-libnet-imap-simple-perl (1.1903-1) UNRELEASED; urgency=low
+libnet-imap-simple-perl (1.1905-1) UNRELEASED; urgency=low
 
   TODO: this has Net::IMAP::Server in Configure_Requires. This means
   we need to have that package done before this one can be tested.
@@ -8,7 +8,7 @@
   * New upstream release
     + Now bundles Net::IMAP::Server for use in tests
 
- -- Jonathan Yu <frequency at cpan.org>  Sat, 18 Jul 2009 08:51:34 -0400
+ -- Jonathan Yu <frequency at cpan.org>  Mon, 20 Jul 2009 19:30:04 -0400
 
 libnet-imap-simple-perl (1.1900-1) unstable; urgency=low
 

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server.pm Tue Jul 21 03:29:50 2009
@@ -8,7 +8,7 @@
 use UNIVERSAL::require;
 use Coro;
 
-our $VERSION = '1.20';
+our $VERSION = '1.22';
 
 =head1 NAME
 
@@ -480,13 +480,17 @@
 C<bug-net-imap-server at rt.cpan.org>, or through the web interface at
 L<http://rt.cpan.org>.
 
+A low-traffic mailing list exists for discussion on how to (ab)use
+this module, at
+L<http://lists.bestpractical.com/cgi-bin/mailman/listinfo/net-imap-server>.
+
 =head1 AUTHOR
 
 Alex Vandiver  C<< <alexmv at bestpractical.com> >>
 
 =head1 LICENCE AND COPYRIGHT
 
-Copyright (c) 2008, Best Practical Solutions, LLC.  All rights reserved.
+Copyright (c) 2009, Best Practical Solutions, LLC.  All rights reserved.
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Append.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Append.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Append.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Append.pm Tue Jul 21 03:29:50 2009
@@ -36,10 +36,10 @@
         }
         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 )

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Search.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Search.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Search.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Search.pm Tue Jul 21 03:29:50 2009
@@ -5,6 +5,7 @@
 use bytes;
 
 use base qw/Net::IMAP::Server::Command/;
+use DateTime::Format::Strptime;
 
 sub validate {
     my $self = shift;
@@ -26,6 +27,8 @@
     $self->untagged_response(join(" ", SEARCH => @results));
     $self->ok_completed;
 }
+
+my $arg_parser = DateTime::Format::Strptime->new(pattern => "%e-%b-%Y");
 
 sub filter {
     my $self = shift;
@@ -43,7 +46,12 @@
             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 @@
             $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 @@
             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;
@@ -149,7 +182,7 @@
             };
             $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))) {

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Uid.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Uid.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Uid.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Command/Uid.pm Tue Jul 21 03:29:50 2009
@@ -74,7 +74,7 @@
     $self->connection->ignore_flags(1) if $what =~ /\.SILENT$/i;
     for my $m (@messages) {
         $m->store( $what => $flags );
-        $self->connection->untagged_fetch->{$self->connection->sequence($m)}{UID}++
+        $self->connection->_unsent_fetch->{$self->connection->sequence($m)}{UID}++
           unless $what =~ /\.SILENT$/i;
         cede;
     }

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Connection.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Connection.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Connection.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Connection.pm Tue Jul 21 03:29:50 2009
@@ -12,7 +12,18 @@
 use Net::IMAP::Server::Command;
 
 __PACKAGE__->mk_accessors(
-    qw(server io_handle _selected selected_read_only model pending temporary_messages temporary_sequence_map previous_exists untagged_expunge untagged_fetch ignore_flags last_poll in_poll commands timer coro _session_flags)
+    qw(server coro io_handle model auth
+       timer commands pending
+       selected_read_only
+       _selected
+
+       temporary_messages temporary_sequence_map
+       ignore_flags
+       _session_flags
+
+       last_poll previous_exists in_poll
+       _unsent_expunge _unsent_fetch
+       )
 );
 
 =head1 NAME
@@ -35,13 +46,13 @@
     my $class = shift;
     my $self  = $class->SUPER::new(
         {   @_,
-            state            => "unauth",
-            untagged_expunge => [],
-            untagged_fetch   => {},
-            last_poll        => time,
-            commands         => 0,
-            coro             => $Coro::current,
-            _session_flags   => {},
+            state           => "unauth",
+            _unsent_expunge => [],
+            _unsent_fetch   => {},
+            last_poll       => time,
+            commands        => 0,
+            coro            => $Coro::current,
+            _session_flags  => {},
         }
     );
     $self->update_timer;
@@ -209,6 +220,10 @@
 
 Returns the L<EV> watcher in charge of the inactivity timer.
 
+=head2 commands
+
+Returns the number of client commands the connection has processed.
+
 =head2 handle_command
 
 Handles a single line from the client.  This is not quite the same as
@@ -415,7 +430,10 @@
 Gets or sets the last time the selected mailbox was polled, in seconds
 since the epoch.
 
-=cut
+=head2 previous_exists
+
+The high-water mark of how many messages the client has been told are
+in the mailbox.
 
 =head2 send_untagged
 
@@ -440,32 +458,32 @@
         $self->in_poll(0);
     }
 
-    for my $s ( keys %{ $self->untagged_fetch } ) {
+    for my $s ( keys %{ $self->_unsent_fetch } ) {
         my ($m) = $self->get_messages($s);
         $self->untagged_response(
                   $s 
                 . " FETCH "
                 . Net::IMAP::Server::Command->data_out(
-                [ $m->fetch( [ keys %{ $self->untagged_fetch->{$s} } ] ) ]
+                [ $m->fetch( [ keys %{ $self->_unsent_fetch->{$s} } ] ) ]
                 )
         );
     }
-    $self->untagged_fetch( {} );
+    $self->_unsent_fetch( {} );
 
     if ( $args{expunged} ) {
 
 # Make sure that they know of at least the existence of what's being expunged.
         my $max = 0;
-        $max = $max < $_ ? $_ : $max for @{ $self->untagged_expunge };
+        $max = $max < $_ ? $_ : $max for @{ $self->_unsent_expunge };
         $self->untagged_response("$max EXISTS")
             if $max > $self->previous_exists;
 
         # Send the expunges, clear out the temporary message store
         $self->previous_exists(
-            $self->previous_exists - @{ $self->untagged_expunge } );
+            $self->previous_exists - @{ $self->_unsent_expunge } );
         $self->untagged_response( map {"$_ EXPUNGE"}
-                @{ $self->untagged_expunge } );
-        $self->untagged_expunge( [] );
+                @{ $self->_unsent_expunge } );
+        $self->_unsent_expunge( [] );
         $self->temporary_messages(undef);
     }
 
@@ -547,17 +565,6 @@
     return $base;
 }
 
-=head2 session_flags MESSAGE
-
-=cut
-
-sub session_flags {
-    my $self = shift;
-    my ($message) = shift;
-    $self->_session_flags->{$message . ""} ||= {};
-    return $self->_session_flags->{$message . ""};
-}
-
 =head2 log MESSAGE
 
 Logs the message to standard error, using C<warn>.

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Mailbox.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Mailbox.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Mailbox.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Mailbox.pm Tue Jul 21 03:29:50 2009
@@ -304,7 +304,7 @@
     for my $c ( Net::IMAP::Server->concurrent_mailbox_connections($self) ) {
 
         # Also, each connection gets these added to their expunge list
-        push @{ $c->untagged_expunge }, @ids;
+        push @{ $c->_unsent_expunge }, @ids;
     }
 
     return 1;

Modified: trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Message.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Message.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Message.pm (original)
+++ trunk/libnet-imap-simple-perl/inc/Net/IMAP/Server/Message.pm Tue Jul 21 03:29:50 2009
@@ -10,6 +10,11 @@
 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;
 $FLAGS{ lc $_ } = $_ for qw(\Answered \Flagged \Deleted \Seen \Draft);
@@ -17,7 +22,7 @@
 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 +40,7 @@
     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 +65,82 @@
 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 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
 
@@ -81,7 +157,8 @@
 
 =head2 expunged
 
-=cut
+Returns true if the message has been marked as "to be expunged" by
+L</expunge>.
 
 =head2 copy_allowed MAILBOX
 
@@ -121,7 +198,8 @@
 
 =head2 session_flags
 
-Returns the list of flags that are stored per-session.
+Returns the names of flags that are stored per-session.  Defaults to
+only the C<\Recent> flag.
 
 =cut
 
@@ -133,7 +211,7 @@
     my $self = shift;
     my $conn = Net::IMAP::Server->connection;
     return {} unless $conn;
-    return $conn->session_flags($self) || {};
+    return $conn->_session_flags->{$self} ||= {};
 }
 
 =head2 set_flag FLAG [, SILENT]
@@ -162,7 +240,7 @@
             )
             )
         {
-            $c->untagged_fetch->{ $c->sequence($self) }{FLAGS}++
+            $c->_unsent_fetch->{ $c->sequence($self) }{FLAGS}++
                 unless $c->ignore_flags;
         }
     }
@@ -196,7 +274,7 @@
             )
             )
         {
-            $c->untagged_fetch->{ $c->sequence($self) }{FLAGS}++
+            $c->_unsent_fetch->{ $c->sequence($self) }{FLAGS}++
                 unless $c->ignore_flags;
         }
     }
@@ -393,6 +471,7 @@
     }
 
     return $result unless defined $start;
+    return "" if $start > length $result;
     return substr( $result, $start ) unless defined $end;
     return substr( $result, $start, $end );
 }

Modified: trunk/libnet-imap-simple-perl/t/test_server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/t/test_server.pm?rev=40366&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/t/test_server.pm (original)
+++ trunk/libnet-imap-simple-perl/t/test_server.pm Tue Jul 21 03:29:50 2009
@@ -4,7 +4,11 @@
 use IO::Socket::INET;
 no warnings;
 
-use lib 'inc'; # use our local copy of Net::IMAP::Server
+BEGIN {
+    eval q [use lib 'inc'] # use our local copy of Net::IMAP::Server
+        unless $ENV{USE_SYSTEM_COPY};
+}
+
 for my $mod (qw(Coro::EV Net::IMAP::Server IO::Socket::SSL)) {
     my $res = do {
         # NOTE: the imap server emits various startup warnings on import
@@ -61,7 +65,12 @@
         redo unless $line =~ m/OK/;
     };
 
+    my $file = $INC{'Net/IMAP/Server.pm'};
+    my $ver  = $Net::IMAP::Server::VERSION;
+
     chomp $line;
+    $line =~ s/(\* OK).*/$1 $file ($ver)/;
+
     my $len = length $line; $len ++;
     print STDERR "\e7\e[5000C\e[${len}D$line\e8";
     close $imapfh;




More information about the Pkg-perl-cvs-commits mailing list