r52116 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod t/basic.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Feb 3 17:07:12 UTC 2010
Author: jawnsy-guest
Date: Wed Feb 3 17:06:49 2010
New Revision: 52116
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52116
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.23)
Modified:
branches/upstream/libmail-imapclient-perl/current/Changes
branches/upstream/libmail-imapclient-perl/current/META.yml
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
branches/upstream/libmail-imapclient-perl/current/t/basic.t
Modified: branches/upstream/libmail-imapclient-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/Changes?rev=52116&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Wed Feb 3 17:06:49 2010
@@ -4,6 +4,19 @@
Changes from 2.99_01 to 3.16 made by Mark Overmeer
Changes from 0.09 to 2.99_01 made by David Kernen
- Potential compatibility issues from 3.17+ highlighted with '*'
+
+version 3.23: Fri Jan 29 00:39:27 EST 2010
+ - new beta idle_data() method to retrieve untagged messages during idle
+ similar to method suggested by Daniel Richard G
+ - added/updated documentation for idle, idle_data, and done
+ - rt.cpan.org#53998: fix NTLM auth: call ntlm with challenge string
+ [Dragoslav Mlakar]
+ - report the return value from select/_read_more on errors
+ - logout() again returns the success/failure of the LOGOUT command
+ - set/return error when $response->() returns undef in authenticate()
+ - new internal method _load_module() centralizing some 'require' calls
+ - localize use $@ in several places to avoid stomping on global val
+ - refactor code calling _read_more() to centralize error handling
version 3.22: Thu Jan 21 15:25:54 EST 2010
- rt.cpan.org#52313: Getting read errors if Fast_io is set to 1
Modified: branches/upstream/libmail-imapclient-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/META.yml?rev=52116&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Wed Feb 3 17:06:49 2010
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Mail-IMAPClient
-version: 3.22
+version: 3.23
version_from: lib/Mail/IMAPClient.pm
installdirs: site
requires:
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm?rev=52116&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Wed Feb 3 17:06:49 2010
@@ -5,7 +5,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.22';
+our $VERSION = '3.23';
use Mail::IMAPClient::MessageSet;
@@ -43,6 +43,28 @@
SEEN SENTBEFORE SENTON SENTSINCE SINCE SMALLER SUBJECT
TEXT TO UID UNANSWERED UNDELETED UNDRAFT UNFLAGGED
UNKEYWORD UNSEEN);
+
+# modules require(d) during runtime when applicable
+my %Load_Module = (
+ "SSL" => "IO::Socket::SSL",
+ "BodyStructure" => "Mail::IMAPClient::BodyStructure",
+ "Envelope" => "Mail::IMAPClient::BodyStructure::Envelope",
+ "Thread" => "Mail::IMAPClient::Thread",
+);
+
+sub _load_module {
+ my $self = shift;
+ my $modkey = shift;
+ my $module = $Load_Module{$modkey} || $modkey;
+
+ local ($@); # avoid stomping on global $@
+ eval "require $module";
+ if ($@) {
+ $self->LastError("Unable to load '$module': $@");
+ return undef;
+ }
+ return $module;
+}
sub _debug {
my $self = shift;
@@ -106,10 +128,10 @@
my $socket = $self->{Socket}
or return undef;
+ local ($@); # avoid stomping on global $@
unless ($use) {
eval { fcntl( $socket, F_SETFL, delete $self->{_fcntl} ) }
if exists $self->{_fcntl};
- $@ = '';
$self->{Fast_io} = 0;
return undef;
}
@@ -119,7 +141,6 @@
$self->{Fast_io} = 0;
$self->_debug("not using Fast_IO; not available on this platform")
unless $self->{_fastio_warning_}++;
- $@ = '';
return undef;
}
@@ -302,12 +323,7 @@
else {
my $ioclass = "IO::Socket::INET";
if ( $self->Ssl ) {
- $ioclass = "IO::Socket::SSL";
- eval "require $ioclass";
- if ($@) {
- $self->LastError("Unable to load '$ioclass' for Ssl: $@");
- return undef;
- }
+ $ioclass = $self->_load_module("SSL") or return undef;
}
$self->_debug("Connecting via $ioclass to $server:$port @timeout");
@@ -391,13 +407,7 @@
# MUST discard cached capability info; should re-issue capability command
delete $self->{CAPABILITY};
- my $ioclass = "IO::Socket::SSL";
- eval "require $ioclass";
- if ($@) {
- $self->LastError("Unable to load '$ioclass' for starttls: $@");
- return undef;
- }
-
+ my $ioclass = $self->_load_module("SSL") or return undef;
my $sock = $self->RawSocket;
my $blocking = $sock->blocking;
@@ -1215,6 +1225,40 @@
$self->_imap_command( "IDLE", $good ) ? $count : undef;
}
+sub idle_data {
+ my $self = shift;
+ my $timeout = defined( $_[0] ) ? shift : 0.025;
+ my $socket = $self->Socket;
+
+ # current index in Results array
+ my $trans_c1 = $self->_next_index;
+
+ # look for all untagged responses
+ my $rc;
+ while (
+ (
+ $rc =
+ $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout )
+ ) > 0
+ )
+ {
+ $self->_get_response( '*', qr/\S+/ ) or return undef;
+ }
+
+ # select returns -1 on errors
+ return undef if $rc < 0;
+
+ my $trans_c2 = $self->_next_index;
+
+ # if current index in Results array has changed return data
+ my @res;
+ if ( $trans_c1 < $trans_c2 ) {
+ @res = $self->Results;
+ @res = @res[ $trans_c1 .. ( $trans_c2 - 1 ) ];
+ }
+ return wantarray ? @res : \@res;
+}
+
sub done {
my $self = shift;
my $count = shift || $self->Count;
@@ -1268,7 +1312,7 @@
unless (
$! == EPIPE
or $! == ECONNRESET
- or $self->LastError =~ /(?:timeout|error) waiting\b/
+ or $self->LastError =~ /(?:error\(.*?\)|timeout) waiting\b/
or $self->LastError =~ /(?:socket closed|\* BYE)\b/
# BUG? reconnect if caller ignored/missed earlier errors?
@@ -1314,7 +1358,7 @@
# options:
# addcrlf => 0|1 - suppress adding CRLF to $string
# addtag => 0|1 - suppress adding $tag to $string
-# tag => $tag - use this $tag instead of incrementing count
+# tag => $tag - use this $tag instead of incrementing $self->Count
sub _imap_command_do {
my $self = shift;
my $opt = ref( $_[0] ) eq "HASH" ? shift : {};
@@ -1414,6 +1458,7 @@
}
if ($code) {
+ $code =~ s/$CR?$LF?$//o;
$code = uc($code) unless ( $good and $code eq $good );
# on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
@@ -1588,23 +1633,8 @@
my $transno = $self->Transaction;
if ($timeout) {
- my $rc = _read_more( $socket, $timeout );
- unless ( $rc > 0 ) {
- my $msg =
- ( $rc ? "error" : "timeout" )
- . " waiting ${timeout}s for data from server"
- . ( $! ? ": $!" : "" );
- $self->LastError($msg);
- $self->_record(
- $transno,
- [
- $self->_next_index($transno), "ERROR",
- "$transno * NO $msg"
- ]
- );
- $self->_disconnect; # BUG: can not handle timeouts gracefully
- return undef;
- }
+ my $rc = $self->_read_more( $socket, $timeout );
+ return undef unless ( $rc > 0 );
}
my $emsg;
@@ -1687,25 +1717,10 @@
while ( $expected_size > length $litstring ) {
if ($timeout) {
- my $rc = _read_more( $socket, $timeout );
- unless ( $rc > 0 ) {
- my $msg =
- ( $rc ? "error" : "timeout" )
- . " waiting ${timeout}s for literal data from server"
- . ( $! ? ": $!" : "" );
- $self->LastError($msg);
- $self->_record(
- $transno,
- [
- $self->_next_index($transno), "ERROR",
- "$transno * NO $msg"
- ]
- );
- $self->_disconnect; # BUG: can not handle timeouts
- return undef;
- }
+ my $rc = $self->_read_more( $socket, $timeout );
+ return undef unless ( $rc > 0 );
}
- else { # 25 ms before retry
+ else { # 25 ms before retry
CORE::select( undef, undef, undef, 0.025 );
}
@@ -1797,7 +1812,9 @@
$rm ? $rm->(@_) : sysread( $fh, $$buf, $len, $off );
}
-sub _read_more($$) {
+sub _read_more {
+ my $self = shift;
+ my $opt = ref( $_[0] ) eq "HASH" ? shift : {};
my ( $socket, $timeout ) = @_;
# IO::Socket::SSL buffers some data internally, so there might be some
@@ -1807,7 +1824,30 @@
my $rvec = '';
vec( $rvec, fileno($socket), 1 ) = 1;
- return CORE::select( $rvec, undef, $rvec, $timeout );
+
+ my $rc = CORE::select( $rvec, undef, $rvec, $timeout );
+
+ # fast track success
+ return $rc if $rc > 0;
+
+ # by default set an error on timeout
+ my $err_on_timeout =
+ exists $opt->{error_on_timeout} ? $opt->{error_on_timeout} : 1;
+
+ # $rc is 0 then we timed out
+ return $rc if !$rc and !$err_on_timeout;
+
+ # set the appropriate error and return
+ my $transno = $self->Transaction;
+ my $msg =
+ ( $rc ? "error($rc)" : "timeout" )
+ . " waiting ${timeout}s for data from server"
+ . ( $! ? ": $!" : "" );
+ $self->LastError($msg);
+ $self->_record( $transno,
+ [ $self->_next_index($transno), "ERROR", "$transno * NO $msg" ] );
+ $self->_disconnect; # BUG: can not handle timeouts gracefully
+ return $rc;
}
sub _trans_index() {
@@ -1876,8 +1916,9 @@
sub logout {
my $self = shift;
- $self->_imap_command("LOGOUT");
+ my $rc = $self->_imap_command("LOGOUT");
$self->_disconnect;
+ return $rc;
}
sub _disconnect {
@@ -1888,6 +1929,7 @@
delete $self->{_IMAP4REV1};
$self->State(Unconnected);
if ( my $sock = delete $self->{Socket} ) {
+ local ($@); # avoid stomping on global $@
eval { $sock->close };
}
$self;
@@ -1946,17 +1988,15 @@
# Updated to handle embedded literal strings
sub get_bodystructure {
my ( $self, $msg ) = @_;
- unless ( eval { require Mail::IMAPClient::BodyStructure; } ) {
- $self->LastError("Unable to use get_bodystructure: $@");
- return undef;
- }
+
+ my $class = $self->_load_module("BodyStructure") or return undef;
my $out = $self->fetch( $msg, "BODYSTRUCTURE" ) or return undef;
my $bs = "";
my $output = first { /BODYSTRUCTURE\s+\(/i } @$out; # Wee! ;-)
if ( $output =~ /$CRLF$/o ) {
- $bs = eval { Mail::IMAPClient::BodyStructure->new($output) };
+ $bs = eval { $class->new($output) }; # BUG? localize $@ here?
}
else {
$self->_debug("get_bodystructure: reassembling original response");
@@ -1965,7 +2005,7 @@
foreach my $o ( $self->_transaction ) {
next unless $self->_is_output_or_literal($o);
$started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i;
- ; # Hi, vi! ;-)
+ ; # Hi, vi! ;-)
$started or next;
if ( length $output && $self->_is_literal($o) ) {
@@ -1979,7 +2019,7 @@
$self->_debug("get_bodystructure: reassembled output=$output<END>");
}
- eval { $bs = Mail::IMAPClient::BodyStructure->new($output) };
+ eval { $bs = $class->new($output) }; # BUG? localize $@ here?
}
$self->_debug(
@@ -1990,10 +2030,10 @@
# Updated to handle embedded literal strings
sub get_envelope {
my ( $self, $msg ) = @_;
- unless ( eval { require Mail::IMAPClient::BodyStructure; } ) {
- $self->LastError("Unable to use get_envelope: $@");
- return undef;
- }
+
+ # Envelope class is defined within BodyStructure
+ my $class = $self->_load_module("BodyStructure") or return undef;
+ $class .= "::Envelope";
my $out = $self->fetch( $msg, 'ENVELOPE' ) or return undef;
@@ -2006,7 +2046,7 @@
}
if ( $output =~ /$CRLF$/o ) {
- eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) };
+ eval { $bs = $class->new($output) }; # BUG? localize $@ here?
}
else {
$self->_debug("get_envelope: reassembling original response");
@@ -2032,7 +2072,7 @@
$self->_debug("get_envelope: reassembled output=$output<END>");
}
- eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) };
+ eval { $bs = $class->new($output) }; # BUG? localize $@ here?
}
$self->_debug( "get_envelope: msg $msg returns ref: " . $bs || "UNDEF" );
@@ -2653,13 +2693,12 @@
unless ($thread_parser) {
return if $thread_parser == 0;
- eval { require Mail::IMAPClient::Thread; };
- if ($@) {
- $self->LastError($@);
+ my $class = $self->_load_module("Thread");
+ unless ($class) {
$thread_parser = 0;
return undef;
}
- $thread_parser = Mail::IMAPClient::Thread->new;
+ $thread_parser = $class->new;
}
my $thread;
@@ -3028,6 +3067,7 @@
}
}
+ # BUG? use _load_module for these too?
if ( $scheme eq 'CRAM-MD5' ) {
$response ||= sub {
my ( $code, $client ) = @_;
@@ -3082,14 +3122,19 @@
my ( $code, $client ) = @_;
require Authen::NTLM;
- Authen::NTLM::ntlm_user( $self->User );
- Authen::NTLM::ntlm_password( $self->Password );
- Authen::NTLM::ntlm_domain( $self->Domain ) if $self->Domain;
- Authen::NTLM::ntlm();
+ Authen::NTLM::ntlm_user( $client->User );
+ Authen::NTLM::ntlm_password( $client->Password );
+ Authen::NTLM::ntlm_domain( $client->Domain ) if $client->Domain;
+ Authen::NTLM::ntlm($code);
};
}
- unless ( $self->_send_line( $response->( $code, $self ) ) ) {
+ my $resp = $response->( $code, $self );
+ unless ( defined($resp) ) {
+ $self->LastError( "Error getting $scheme data: " . $self->LastError );
+ return undef;
+ }
+ unless ( $self->_send_line($resp) ) {
$self->LastError( "Error sending $scheme data: " . $self->LastError );
return undef;
}
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod?rev=52116&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Wed Feb 3 17:06:49 2010
@@ -998,37 +998,35 @@
Example:
- $imap->disconnect or warn "Could not disconnect: $@\n";
-
-Disconnects the IMAPClient object from the server. Functionally
-equivalent to the L</logout> method. (In fact it's actually a synonym
-for L</logout>.)
+ $imap->disconnect or warn "Could not logout: $@\n";
+
+This method calls L</logout>, see L</logout> for details.
=head2 done
Example:
- my $tag = $imap->idle or warn "Couldn't idle: $@\n";
- goDoOtherThings();
- $imap->done($tag) or warn "Error from done: $@\n";
-
-The B<done> method tells the IMAP server that the connection is
-finished idling. See L</idle> for more information. It accepts one
-argument, which is the I<tag> (identifier) received from the previous
-call to L</idle>. If no I<tag> is specified when calling B<done> then
-the default I<tag> using an internal B<Count> attribute is assumed to
-be the I<tag> to use.
+ my $tag = $imap->idle or warn "idle failed: $@\n";
+ doSomethingA();
+ my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n";
+ doSomethingB();
+ my $results = $imap->done($tag) or warn "Error from done: $@\n";
+
+The B<done> method tells the IMAP server to terminate the IDLE
+command. The only argument is the I<tag> (identifier) received from
+the previous call to L</idle>. If I<tag> is not specified a default
+I<tag> based on the B<Count> attribute is assumed to be the I<tag> to
+look for in the response from the server.
If an invalid I<tag> is specified, or the default I<tag> is wrong,
then B<done> will hang indefinitely or until a timeout occurs.
-If you call done without previously having called L</idle> then the
-server will likely respond with I<* BAD Invalid tag>.
-
-If you try to run any other mailbox method after calling L</idle> but
-before calling L</done>, then that method will not only fail but also
-take you out of the IDLE state. In this case, a subsequent call to
-B<done> would result in an error.
+If B<done> is called when an L</idle> command is not active then the
+server will likely respond with an error like I<* BAD Invalid tag>.
+
+On failure <undef> is returned and L</LastError> is set.
+
+See also L</idle>, L</imap_data> and L</Results>.
=head2 examine
@@ -1336,35 +1334,63 @@
Example:
- my $idle = $imap->idle or warn "Couldn't idle: $@\n";
- goDoOtherThings();
- $imap->done($idle) or warn "Error from done: $@\n";
-
-The B<idle> method places the IMAP connection in an IDLE state. Your
-server must support the IMAP IDLE extension to use this method. (See
-RFC2177 for a discussion of the IDLE IMAP extension.) The B<idle>
-method accepts no arguments and returns a transaction number. This
-transaction number must be supplied as the argument for L</done> when
-the L</done> method is later called.
-
-Use the L</done> method to tell the IMAP server that the connection is
-finished idling.
-
-If you attempt to use the B<idle> method against a server that does
-not have the IDLE capability then the B<idle> method will return
-C<undef>. If you then attempt to use the B<idle> method a second time
-the B<idle> method will return C<undef> again.
-
-If you successfully run the B<idle> method, then you must use the
-L</done> method to stop idling (or to continue, in the parlance of
-RFC2177). Failure to do so will only encourage your server to call
-you I<BAD> and to rant about a I<Bogus IDLE continuation>.
-
-If you try to run any other mailbox method after calling L</idle> but
-before calling L</done>, then that method will not only fail but also
-take you out of the IDLE state. This means that when you eventually
-remember to call B<done> you will just get an I<* BAD Invalid tag>
-message.
+ my $tag = $imap->idle or warn "idle failed: $@\n";
+ doSomethingA();
+ my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n";
+ doSomethingB();
+ my $results = $imap->done($tag) or warn "Error from done: $@\n";
+
+The B<idle> method tells the IMAP server the client is ready to accept
+unsolicited mailbox update messages. This method is only valid on
+servers that support the IMAP IDLE extension, see RFC2177 for details.
+
+The B<idle> method accepts no arguments and returns the I<tag>
+(identifier) that was sent by the client for this command. This tag
+should be supplied as the argument to L</done> when ending the IDLE
+command.
+
+On failure <undef> is returned and L</LastError> is set.
+
+The method L</idle_data> may be used once B<idle> has been successful.
+However, no mailbox operations may be called until the B<idle> command
+has been terminated by calling L</done>. Failure to do so will result
+in an error and the idle command will typically be terminated by the
+server.
+
+See also L</imap_data> and L</done>.
+
+=head2 idle_data
+
+Example:
+
+ my $tag = $imap->idle or warn "idle failed: $@\n";
+ doSomethingA();
+ my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n";
+ doSomethingB();
+ my $results = $imap->done($tag) or warn "Error from done: $@\n";
+
+The B<idle_data> method can be used to accept any unsolicited mailbox
+update messages that have been sent by the server during an L</idle>
+command. This method does not send any commands to the server, it
+simply waits for data from the server and returns that data to the
+caller.
+
+The B<idle> method accepts an optional $timeout argument and returns
+an array (or an array reference if called in scalar context) with the
+messages from the server.
+
+By default a timeout of 0 seconds is used (do not block). Internally
+the timeout is passed to L<perlfunc/select>. The timeout controls how
+long the select call blocks if there are no messages waiting to be
+read from the server.
+
+On failure <undef> is returned and L</LastError> is set.
+
+See also L</imap> and L</done>.
+
+Version note: method added in Mail::IMAPClient 3.23
+Warning: this method is considered experimental and the
+interface/output may change in a future version.
=head2 imap4rev1
Modified: branches/upstream/libmail-imapclient-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/t/basic.t?rev=52116&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/basic.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/basic.t Wed Feb 3 17:06:49 2010
@@ -32,7 +32,7 @@
@missing
? plan skip_all => "missing value for: @missing"
- : plan tests => 66;
+ : plan tests => 67;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
@@ -303,21 +303,16 @@
ok( $im2->close, "close" );
$im2->delete($migtarget);
-ok( $im2->logout, "logout" );
+ok( $im2->logout, "logout" ) or diag("logout error: $@");
# Test IDLE
-{
- if ( $imap->has_capability("IDLE") ) {
- ok( my $idle = $imap->idle, "idle" );
- sleep 1;
- ok( $imap->done($idle), "done" );
- ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
- }
- else {
- ok( 1, "idle not supported" );
- ok( 1, "skipping 1/2 idle tests" );
- ok( 1, "skipping 2/2 idle tests" );
- }
+SKIP: {
+ skip "IDLE not supported", 4 unless $imap->has_capability("IDLE");
+ ok( my $idle = $imap->idle, "idle" );
+ sleep 1;
+ ok( $imap->idle_data, "idle_data" );
+ ok( $imap->done($idle), "done" );
+ ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
}
$imap->select('inbox');
@@ -342,7 +337,7 @@
# Test STARTTLS - an optional feature so tests always succeed
{
- ok( $imap->logout, "logout" );
+ ok( $imap->logout, "logout" ) or diag("logout error: $@");
$imap->connect( Starttls => 1 );
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
}
More information about the Pkg-perl-cvs-commits
mailing list