r70846 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod t/fetch_hash.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Mar 8 03:20:38 UTC 2011
Author: jawnsy-guest
Date: Tue Mar 8 03:20:24 2011
New Revision: 70846
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70846
Log:
[svn-upgrade] new version libmail-imapclient-perl (3.28)
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/fetch_hash.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=70846&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Tue Mar 8 03:20:24 2011
@@ -4,6 +4,21 @@
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.28_04: Fri Mar 4 00:17:38 EST 2011
+ - rt.cpan.org#66004: internaldate() return undef if no internaldate in reply
+ [Jason Long]
+ - rt.cpan.org#66367: fetch_hash uses Escaped_results() in 3.26/3.27
+ (redo) rt.cpan.org#63524: fetch_hash() parse errors
+ [Mathias Reitinger]
+ + fetch_hash: only Escape() data in parenthesized list
+ + update fetch_hash test and add a new test
+ - do not touch CRLF in Escape()/Unescape()
+ - added Escape() method
+ - rt.cpan.org#66287: flags results truncated due to Maxcommandlength
+ [Erik Colson]
+ - rt.cpan.org#65694: SASL PLAIN: bad order of login data
+ [Willi Mann]
version 3.27: Sun Feb 13 14:37:27 EST 2011
- rt.cpan.org#65694: migrate fails
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=70846&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Tue Mar 8 03:20:24 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mail-IMAPClient
-version: 3.27
+version: 3.28
abstract: IMAP4 client library
author:
- Phil Pearl (Lobbes) <phil at zimbra.com>
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=70846&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Tue Mar 8 03:20:24 2011
@@ -7,7 +7,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.27';
+our $VERSION = '3.28';
use Mail::IMAPClient::MessageSet;
@@ -1708,7 +1708,7 @@
# literal is appended to previous data
if ( $self->_is_literal($line) ) {
- $data =~ s/([\\\(\)"$CRLF])/\\$1/og;
+ $data = $self->Escape($data);
$a[-1] .= qq( "$data");
$prevwasliteral = 1;
}
@@ -1726,10 +1726,16 @@
return wantarray ? @a : \@a;
}
+sub Escape {
+ my $data = $_[1];
+ $data =~ s/([\\\"])/\\$1/og;
+ return $data;
+}
+
sub Unescape {
- my $whatever = $_[1];
- $whatever =~ s/\\([\\\(\)"$CRLF])/$1/og;
- $whatever;
+ my $data = $_[1];
+ $data =~ s/\\([\\\"])/$1/og;
+ return $data;
}
sub logout {
@@ -2001,7 +2007,7 @@
}
my %words = map { uc($_) => 1 } @words;
- my $output = $self->fetch( { escaped => 1 }, $msgs, "($what)" )
+ my $output = $self->fetch( $msgs, "($what)" )
or return undef;
while ( my $l = shift @$output ) {
@@ -2025,7 +2031,7 @@
$l = shift @$output;
next ATTR;
}
- elsif ( $l =~ m/\G(?:"([^"]+)"|([^()\s]+))\s*/gc ) {
+ elsif ( $l =~ m/\G(?:"(.*?)(?:(?<!\\)")|([^()\s]+))\s*/gc ) {
$value = defined $1 ? $1 : $2;
$entry->{$key} = $value;
next ATTR;
@@ -2050,6 +2056,13 @@
else {
$value .= $stuff;
}
+
+ # consume literal data if any
+ if ( $l =~ m/\G\s*$/gc and scalar(@$output) ) {
+ my $elit = $self->Escape( shift @$output );
+ $l = shift @$output;
+ $value .= ( length($value) ? " " : "" ) . qq{"$elit"};
+ }
}
$l =~ m/\G\s*/gc;
}
@@ -2207,13 +2220,13 @@
$msg->cat(@_) if @_;
# Send command
- $self->fetch( $msg, "FLAGS" ) or return undef;
+ my $ref = $self->fetch( $msg, "FLAGS" ) or return undef;
my $u_f = $self->Uid;
my $flagset = {};
# Parse results, setting entry in result hash for each line
- foreach my $line ( $self->Results ) {
+ foreach my $line (@$ref) {
$self->_debug("flags: line = '$line'");
if (
$line =~ /\* \s+ (\d+) \s+ FETCH \s+ # * nnn FETCH
@@ -2661,10 +2674,8 @@
my ( $self, $msg ) = @_;
$self->_imap_uid_command( FETCH => $msg, 'INTERNALDATE' )
or return undef;
- my $internalDate = join '', $self->History;
- $internalDate =~ s/^.*INTERNALDATE "//si;
- $internalDate =~ s/\".*$//s;
- $internalDate;
+ my $hist = join '', $self->History;
+ return $hist =~ /\bINTERNALDATE "([^"]*)"/i ? $1 : undef;
}
sub is_parent {
@@ -2973,13 +2984,14 @@
elsif ( $scheme eq 'PLAIN' ) { # PLAIN SASL
$response ||= sub {
my ( $code, $client ) = @_;
- encode_base64(
- $client->User
- . chr(0)
- . $client->Proxy
- . chr(0)
- . $client->Password,
- ''
+ encode_base64( # [authname] user password
+ join(
+ chr(0),
+ defined $client->Proxy
+ ? ( $client->User, $client->Proxy )
+ : ( "", $client->User ),
+ defined $client->Password ? $client->Password : "",
+ ),
);
};
}
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=70846&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Tue Mar 8 03:20:24 2011
@@ -94,7 +94,13 @@
=item PLAIN (SASL)
-PLAIN (SASL) authentication requires the use of the L</Proxy> parameter.
+PLAIN (SASL) authentication allows the optional use of the L</Proxy>
+parameter. RFC 4616 documents this syntax for SASL PLAIN:
+
+ message = [authzid] UTF8NUL authcid UTF8NUL passwd
+
+When L</Proxy> is defined, L</User> is used as 'authzid' and L</Proxy>
+is used as 'authcid'. Otherwise, L</User> is used as 'authcid'.
=item NTLM
@@ -1056,16 +1062,14 @@
}
};
-By itself this method may be useful for, say, speeding up programs that
-want the size of every message in a folder. It issues one command and
-receives one (possibly long!) response from the server. However, it's
-true power lies in the as-yet-unwritten methods that will rely on this
-method to deliver even more powerful result hashes. Look for more new
-function in later releases.
-
-This method is new with version 2.2.3 and is thus still experimental.
-If you decide to try this method and run into problems, please see the
-section on L</REPORTING BUGS>.
+By itself this method may be useful for tasks like obtaining the size
+of every message in a folder. It issues one command and receives one
+(possibly long!) response from the server.
+
+If the fetch request causes the server to return data in a
+parenthesized list, the data within the parenthesized list may be
+escaped via the Escape() method. Use the Unescape() method to get the
+raw values back in this case.
=head2 flags
@@ -1308,7 +1312,8 @@
or die "Could not internaldate: $@\n";
B<internaldate> accepts one argument, a message id (or UID if the
-L</Uid> parameter is true), and returns that message's internal date.
+L</Uid> parameter is true), and returns that message's internal date
+or undef if the call fails or internal date is not returned.
=head2 get_bodystructure
Modified: branches/upstream/libmail-imapclient-perl/current/t/fetch_hash.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/t/fetch_hash.t?rev=70846&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/fetch_hash.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/fetch_hash.t Tue Mar 8 03:20:24 2011
@@ -9,7 +9,7 @@
use strict;
use warnings;
-use Test::More tests => 19;
+use Test::More tests => 20;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
@@ -100,26 +100,56 @@
],
[
"BODY.PEEK[] requests match BODY[] responses",
- [ q{* 1 FETCH (BODY[] foo)} ],
+ [q{* 1 FETCH (BODY[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY[]" => q{foo}, }, },
],
[
"BODY.PEEK[] requests match BODY.PEEK[] responses also",
- [ q{* 1 FETCH (BODY.PEEK[] foo)} ],
+ [q{* 1 FETCH (BODY.PEEK[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
],
[
- "escaped subject",
- [ q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) } ],
+ "escaped ENVELOPE subject",
+ [
+q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500"},
+ q{foo "bar\\" (baz\\)},
+q{ (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) }
+ ],
[ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ],
{
"1" => {
'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500',
- 'UID' => '1',
- 'FLAGS' => '\\Seen',
- 'ENVELOPE' => q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
+ 'UID' => '1',
+ 'FLAGS' => '\\Seen',
+ 'ENVELOPE' =>
+q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\\\\\" (baz\\\\)" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
+ },
+ },
+ ],
+ [
+ "non-escaped BODY[HEADER.FIELDS (...)]",
+ [
+q{* 1 FETCH (UID 1 FLAGS () BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]},
+ 'From: Phil Pearl (Lobbes) <phil+from at perkpartners.com>
+To: phil+to at perkpartners.com
+Subject: foo "bar\" (baz\)
+Date: Sat, 22 Jan 2011 20:43:58 -0500
+
+'
+ ],
+ [ [1], ( qw(FLAGS), 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' ) ],
+ {
+ '1' => {
+ 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' =>
+ 'From: Phil Pearl (Lobbes) <phil+from at perkpartners.com>
+To: phil+to at perkpartners.com
+Subject: foo "bar\" (baz\)
+Date: Sat, 22 Jan 2011 20:43:58 -0500
+
+',
+ 'FLAGS' => '',
},
},
],
@@ -225,6 +255,7 @@
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
+
sub Escaped_results {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
More information about the Pkg-perl-cvs-commits
mailing list