r38320 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Sat Jun 20 08:49:58 UTC 2009
Author: carnil-guest
Date: Sat Jun 20 08:49:53 2009
New Revision: 38320
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38320
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.19)
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
Modified: branches/upstream/libmail-imapclient-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/Changes?rev=38320&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Sat Jun 20 08:49:53 2009
@@ -4,6 +4,22 @@
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.19: Fri Jun 19 14:59:15 EDT 2009
+ - *search() backwards compat: caller must quote single arg properly
+ rt.cpan.org#47044: $imap->search does not return [ekuemmer]
+ - cleanup regexp in _send_line()
+ - reduce extra newlines injected by _debug()
+
+version 3.19_02: Tue Jun 9 00:47:52 EDT 2009
+ - _list_or_lsub() now calls _list_response_preprocess so
+ consumers of this method no longer need to deal with how
+ LITERAL data is represented in the returned data
+ - update _list_or_lsub_response_parse handling of folder names
+ that came back as literal data
+ - update comments related to _list_response_preprocess
+version 3.19_01: Fri Jun 5 15:45:05 EDT 2009
+ - make parse_headers more robust to errors/non-header data
version 3.18: Wed Jun 3 23:07:12 EDT 2009
- enhance fetch_hash to enable caller to specify list of messages
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=38320&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Sat Jun 20 08:49:53 2009
@@ -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.18
+version: 3.19
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=38320&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Sat Jun 20 08:49:53 2009
@@ -5,7 +5,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
use Mail::IMAPClient::MessageSet;
@@ -450,7 +450,16 @@
$self->_imap_command(qq($cmd "$reference" $target))
or return undef;
- return wantarray ? $self->History : $self->Results;
+ # cleanup any literal data that may be returned
+ my $ret = wantarray ? [ $self->History ] : $self->Results;
+ if ($ret) {
+ my $cmd = wantarray ? undef : shift @$ret;
+ $self->_list_response_preprocess($ret);
+ unshift( @$ret, $cmd ) if defined($cmd);
+ }
+
+ #return wantarray ? $self->History : $self->Results;
+ return wantarray ? @$ret : $ret;
}
sub list { shift->_list_or_lsub( "LIST", @_ ) }
@@ -487,8 +496,6 @@
push @list, @$tref;
}
- $self->_list_response_preprocess( \@list ); # necessary? remove?
-
foreach my $resp (@list) {
my $rec = $self->_list_or_lsub_response_parse($resp);
next unless defined $rec->{name};
@@ -508,14 +515,14 @@
if !$what && $self->{Folders};
my @folders = $self->_folders_or_subscribed( "list", $what );
-
$self->{Folders} = \@folders unless $what;
return wantarray ? @folders : \@folders;
}
sub subscribed {
my ( $self, $what ) = @_;
- $self->_folders_or_subscribed( "lsub", $what );
+ my @folders = $self->_folders_or_subscribed( "lsub", $what );
+ return wantarray ? @folders : \@folders;
}
# BUG? cleanup escaping/quoting
@@ -1368,28 +1375,25 @@
push @{ $self->{History}{$count} }, $array;
}
-#_send_line writes to the socket:
+# _send_line handles literal data and supports the Prewritemethod
sub _send_line {
my ( $self, $string, $suppress ) = ( shift, shift, shift );
- $string =~ s/\r?\n?$/$CRLF/o
+ $string =~ s/$CR?$LF?$/$CRLF/o
unless $suppress;
- if ( $string =~ s/^([^\n{]*\{(\d+)\}$CRLF)(.)/$3/o ) {
-
- # string starts with literal
- my ( $first, $len ) = ( $1, $2 );
+ # handle case where string contains a literal
+ if ( $string =~ s/^([^$LF\{]*\{\d+\}$CRLF)(?=.)//o ) {
+ my $first = $1;
$self->_debug("Sending literal: $first\tthen: $string");
-
$self->_send_line($first) or return undef;
# look for "<anything> OK|NO|BAD" or "+..."
my $code = $self->_get_response( qr(\S+), '+' ) or return undef;
return undef unless $code eq '+';
-
- # non-literal part continues below...
- }
-
+ }
+
+ # non-literal part continues...
unless ( $self->IsConnected ) {
$self->LastError("NO not connected");
return undef;
@@ -1650,7 +1654,7 @@
}
}
- $self->_debug( "Read: " . join "\n ", map { $_->[DATA] } @$oBuffer );
+ $self->_debug( "Read: " . join "", map { "\t" . $_->[DATA] } @$oBuffer );
@$oBuffer ? $oBuffer : undef;
}
@@ -1758,6 +1762,8 @@
# LIST or LSUB Response
# Contents: name attributes, hierarchy delimiter, name
# Example: * LIST (\Noselect) "/" ~/Mail/foo
+# NOTE: in _list_response_preprocess we append literal data so we need
+# to be liberal about our matching of folder name data
sub _list_or_lsub_response_parse {
my ( $self, $resp ) = @_;
@@ -1766,10 +1772,10 @@
$resp =~ s/\015?\012$//;
if (
- $resp =~ / ^\* \s+ (?:LIST|LSUB) \s+
- \( ([^\)]*) \) \s+ # * LIST (attrs)
- (?:\" ([^"]*) \" | NIL ) \s+ # "delimiter" or NIL
- (?:\" (.*) \" | (\S+)) # "name" or name
+ $resp =~ / ^\* \s+ (?:LIST|LSUB) \s+ # * LIST or LSUB
+ \( ([^\)]*) \) \s+ # (attrs)
+ (?: \" ([^"]*) \" | NIL ) \s # "delimiter" or NIL
+ (?:\s*\" (.*) \" | (.*) ) # "name" or name
/ix
)
{
@@ -1779,18 +1785,19 @@
return wantarray ? %info : \%info;
}
-# BUG? Legacy code does this for subscribed() and folders(). Is there
-# a case where lines returned by the server do not end in $CRLF and we
-# need to treat them as a continuation of the previous line?
+# handle listeral data returned in list/lsub responses
+# some example responses:
+# * LIST () "/" "My Folder" # nothing to do here...
+# * LIST () "/" {9} # the {9} is already removed by _read_line()
+# Special % # we append this to the previous line
sub _list_response_preprocess {
my ( $self, $data ) = @_;
return undef unless defined $data;
for ( my $m = 0 ; $m < @$data ; $m++ ) {
- if ( $data->[$m] && $data->[$m] !~ /$CRLF$/o ) {
- local ($!); # old versions of Carp could reset $!
- carp("concatenating $data->[$m] and $data->[$m+1]");
- $data->[$m] .= $data->[ $m + 1 ];
+ if ( $data->[$m] && $data->[$m] !~ /$CR?$LF$/o ) {
+ $self->_debug("concatenating '$data->[$m]' and '$data->[$m+1]'");
+ $data->[$m] .= " " . $data->[ $m + 1 ];
splice @$data, $m + 1, 1;
}
}
@@ -2231,6 +2238,11 @@
my %fieldmap = map { ( lc($_) => $_ ) } @fields;
my $msgid;
+ # some example responses:
+ # * OK Message 1 no longer exists
+ # * 1 FETCH (UID 26535 BODY[HEADER] "")
+ # * 5 FETCH (UID 30699 BODY[HEADER] {1711}
+ # header: value...
foreach my $header ( map { split /$CR?$LF/o } @$raw ) {
# little problem: Windows2003 has UID as body, not in header
@@ -2238,7 +2250,7 @@
$header =~ s/^\* \s+ (\d+) \s+ FETCH \s+
\( (.*?) BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix
)
- { # start new message header
+ { # start new message header
( $msgid, my $msgattrs ) = ( $1, $2 );
$h = {};
if ( $self->Uid ) # undef when win2003
@@ -2262,7 +2274,6 @@
}
unless ( defined $h ) {
- last if $header =~ / OK /i;
$self->_debug("found data between fetch headers: $header");
next;
}
@@ -2273,6 +2284,12 @@
}
elsif ( $field and ref $h->{$field} eq 'ARRAY' ) { # folded header
$h->{$field}[-1] .= $header;
+ }
+ else {
+
+ # show data if it is not like '"")' or '{123}'
+ $self->_debug("non-header data between fetch headers: $header")
+ if ( $header !~ /^(?:\s*\"\"\)|\{\d+\})$CR?$LF$/o );
}
}
@@ -2402,6 +2419,9 @@
elsif ( exists $SEARCH_KEYS{ uc($_) } ) {
push( @ret, $v );
}
+ elsif ( @args == 1 ) {
+ push( @ret, $v ); # <3.17 compat: caller responsible for quoting
+ }
else {
push( @ret, $self->Quote($v) );
}
@@ -2410,11 +2430,11 @@
}
sub search {
- my ( $self, @a ) = @_;
-
- @a = $self->_quote_search(@a);
-
- $self->_imap_uid_command( SEARCH => @a )
+ my ( $self, @args ) = @_;
+
+ @args = $self->_quote_search(@args);
+
+ $self->_imap_uid_command( SEARCH => @args )
or return undef;
my @hits;
@@ -2619,9 +2639,6 @@
my ( $self, $folder ) = ( shift, shift );
my $list = $self->list( undef, $folder ) or return undef;
- shift @$list; # remove command
- $self->_list_response_preprocess($list); # necessary? remove?
-
my $attrs;
foreach my $resp (@$list) {
my $rec = $self->_list_or_lsub_response_parse($resp);
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=38320&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Sat Jun 20 08:49:53 2009
@@ -2093,8 +2093,12 @@
warn "Error in search: $@\n" if $@;
}
- # or
+ # or note: be sure to quote string properly
my $msgs2 = $imap->search( \( $imap->Quote($msgid), "FROM", q{"me"} ) )
+ or warn "search failed: $@\n";
+
+ # or note: be sure to quote string properly
+ my $msgs3 = $imap->search('TEXT "string not in mailbox"')
or warn "search failed: $@\n";
The B<search> method implements the SEARCH IMAP client command. Any
@@ -2113,9 +2117,22 @@
TEXT TO UID UNANSWERED UNDELETED UNDRAFT UNFLAGGED
UNKEYWORD UNSEEN
-To avoid the automatic quoting, you can specify args as scalar
-references (SCALAR) and the values of those SCALAR refs will be passed
-along as-is.
+The following options exist to avoid the automatic quoting (note:
+caller is responsible for verifying the data sent in these cases is
+properly escaped/quoted):
+
+=over 4
+
+=item *
+
+specify a single string/argument in the call to search.
+
+=item *
+
+specify args as scalar references (SCALAR) and the values of those
+SCALAR refs will be passed along as-is.
+
+=back
The B<search> method returns an array containing sequence numbers of
messages that passed the SEARCH IMAP client command's search criteria.
More information about the Pkg-perl-cvs-commits
mailing list