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