r44659 - in /trunk/libmail-imapclient-perl: Changes MANIFEST META.yml debian/changelog lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod lib/Mail/IMAPClient/BodyStructure.pm t/fetch_hash.t
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Wed Sep 23 05:25:22 UTC 2009
Author: carnil-guest
Date: Wed Sep 23 05:25:06 2009
New Revision: 44659
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44659
Log:
* New upstream release
- Bugfixes including update and clarification of the close and expunge
documentation (Closes: #547713)
Added:
trunk/libmail-imapclient-perl/t/fetch_hash.t
- copied unchanged from r44658, branches/upstream/libmail-imapclient-perl/current/t/fetch_hash.t
Modified:
trunk/libmail-imapclient-perl/Changes
trunk/libmail-imapclient-perl/MANIFEST
trunk/libmail-imapclient-perl/META.yml
trunk/libmail-imapclient-perl/debian/changelog
trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pm
trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pod
trunk/libmail-imapclient-perl/lib/Mail/IMAPClient/BodyStructure.pm
Modified: trunk/libmail-imapclient-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/Changes?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/Changes (original)
+++ trunk/libmail-imapclient-perl/Changes Wed Sep 23 05:25:06 2009
@@ -4,6 +4,18 @@
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.21: Tue Sep 22 19:45:13 EDT 2009
+ - rt.cpan.org#49691: rewrite of fetch_hash to resolve several issues
+ [Robert Norris]
+ includes new tests via t/fetch_hash.t
+ - rt.cpan.org#48980: (enhancement) add support for XLIST extension
+ [Robert Norris]
+ - rt.cpan.org#49024: NIL personal name returned by *_addresses methods
+ [Dmitry Bigunyak]
+ - rt.cpan.org#49401: IMAPClient expunge fails (unless folder arg used)
+ [Gary Baluha]
+ - update/clarify close and expunge documentation a little
version 3.20: Fri Aug 21 17:40:40 EDT 2009
- added file/tests in t/simple.t
Modified: trunk/libmail-imapclient-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/MANIFEST?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/MANIFEST (original)
+++ trunk/libmail-imapclient-perl/MANIFEST Wed Sep 23 05:25:06 2009
@@ -32,6 +32,7 @@
sample.perldb
t/basic.t
t/bodystructure.t
+t/fetch_hash.t
t/messageset.t
t/pod.t
t/simple.t
Modified: trunk/libmail-imapclient-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/META.yml?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/META.yml (original)
+++ trunk/libmail-imapclient-perl/META.yml Wed Sep 23 05:25:06 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.20
+version: 3.21
version_from: lib/Mail/IMAPClient.pm
installdirs: site
requires:
Modified: trunk/libmail-imapclient-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/debian/changelog?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/debian/changelog (original)
+++ trunk/libmail-imapclient-perl/debian/changelog Wed Sep 23 05:25:06 2009
@@ -1,8 +1,14 @@
-libmail-imapclient-perl (3.20-3) UNRELEASED; urgency=low
-
+libmail-imapclient-perl (3.21-1) UNRELEASED; urgency=low
+
+ [ Ryan Niebur ]
* Update jawnsy's email address
- -- Ryan Niebur <ryanryan52 at gmail.com> Tue, 01 Sep 2009 21:19:08 -0700
+ [ Salvatore Bonaccorso ]
+ * New upstream release
+ - Bugfixes including update and clarification of the close and expunge
+ documentation (Closes: #547713)
+
+ -- Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com> Wed, 23 Sep 2009 05:23:00 +0000
libmail-imapclient-perl (3.20-2) unstable; urgency=low
Modified: trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pm?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pm (original)
+++ trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pm Wed Sep 23 05:25:06 2009
@@ -5,7 +5,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.20';
+our $VERSION = '3.21';
use Mail::IMAPClient::MessageSet;
@@ -140,8 +140,8 @@
sub Rfc822_date {
my $class = shift;
- my $date = $class =~ /^\d+$/ ? $class : shift; # method or function?
- my @date = gmtime($date);
+ my $date = $class =~ /^\d+$/ ? $class : shift; # method or function?
+ my @date = gmtime($date);
#Date: Fri, 09 Jul 1999 13:10:55 -0000
sprintf(
@@ -159,6 +159,7 @@
sub Rfc2060_date {
$_[0] =~ /^\d+$/ ? Rfc3501_date(@_) : shift->Rfc3501_date(@_);
}
+
sub Rfc3501_date {
my $class = shift;
my $stamp = $class =~ /^\d+$/ ? $class : shift;
@@ -171,6 +172,7 @@
sub Rfc2060_datetime($;$) {
$_[0] =~ /^\d+$/ ? Rfc3501_datetime(@_) : shift->Rfc3501_datetime(@_);
}
+
sub Rfc3501_datetime($;$) {
my $class = shift;
my $stamp = $class =~ /^\d+$/ ? $class : shift;
@@ -477,6 +479,12 @@
sub list { shift->_list_or_lsub( "LIST", @_ ) }
sub lsub { shift->_list_or_lsub( "LSUB", @_ ) }
+sub xlist {
+ my ($self) = @_;
+ return undef unless $self->has_capability("XLIST");
+ shift->_list_or_lsub( "XLIST", @_ );
+}
+
sub _folders_or_subscribed {
my ( $self, $method, $what ) = @_;
my @folders;
@@ -529,6 +537,25 @@
my @folders = $self->_folders_or_subscribed( "list", $what );
$self->{Folders} = \@folders unless $what;
return wantarray ? @folders : \@folders;
+}
+
+sub xlist_folders {
+ my ($self) = @_;
+ my $xlist = $self->xlist;
+ return undef unless defined $xlist;
+
+ my %xlist;
+ my $xlist_re = qr/\A\\(Inbox|AllMail|Trash|Drafts|Sent|Spam|Starred)\Z/;
+
+ for my $resp (@$xlist) {
+ my $rec = $self->_list_or_lsub_response_parse($resp);
+ next unless defined $rec->{name};
+ for my $attr ( @{ $rec->{attrs} } ) {
+ $xlist{$1} = $rec->{name} if ( $attr =~ $xlist_re );
+ }
+ }
+
+ return wantarray ? %xlist : \%xlist;
}
sub subscribed {
@@ -1337,7 +1364,7 @@
if ($code) {
$code = uc($code) unless ( $good and $code eq $good );
- # on a successful LOGOUT $code is OK not BYE
+ # on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
if ( $code eq 'BYE' ) {
$self->State(Unconnected);
$self->LastError($byemsg) if $byemsg;
@@ -1771,7 +1798,7 @@
$self;
}
-# LIST or LSUB Response
+# LIST/XLIST/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
@@ -1784,10 +1811,10 @@
$resp =~ s/\015?\012$//;
if (
- $resp =~ / ^\* \s+ (?:LIST|LSUB) \s+ # * LIST or LSUB
- \( ([^\)]*) \) \s+ # (attrs)
- (?: \" ([^"]*) \" | NIL ) \s # "delimiter" or NIL
- (?:\s*\" (.*) \" | (.*) ) # "name" or name
+ $resp =~ / ^\* \s+ (?:LIST|XLIST|LSUB) \s+ # * LIST|XLIST|LSUB
+ \( ([^\)]*) \) \s+ # (attrs)
+ (?: \" ([^"]*) \" | NIL ) \s # "delimiter" or NIL
+ (?:\s*\" (.*) \" | (.*) ) # "name" or name
/ix
)
{
@@ -2015,55 +2042,84 @@
s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i;
s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i;
}
+ my %words = map { uc($_) => 1 } @words;
my $output = $self->fetch( $msgs, "($what)" ) or return undef;
- for ( my $x = 0 ; $x <= $#$output ; $x++ ) {
- my $entry = {};
- my $l = $output->[$x];
+ while ( my $l = shift @$output ) {
+ next if $l !~ m/^\*\s(\d+)\sFETCH\s\(/g;
+ my ( $mid, $entry ) = ( $1, {} );
+ my ( $key, $value );
+ ATTR:
+ while ( $l !~ m/\G\s*\)\s*$/gc ) {
+ if ( $l =~ m/\G\s*([\w\d\.]+(?:\[[^\]]*\])?)\s*/gc ) {
+ $key = uc($1);
+ }
+ elsif ( !defined $key ) {
+
+ # some kind of malformed response
+ $self->LastError("Invalid item name in FETCH response: $l");
+ return undef;
+ }
+
+ if ( $l =~ m/\G\s*$/gc ) {
+ $value = shift @$output;
+ $entry->{$key} = $value;
+ $l = shift @$output;
+ next ATTR;
+ }
+ elsif ( $l =~ m/\G(?:"([^"]+)"|([^()\s]+))\s*/gc ) {
+ $value = defined $1 ? $1 : $2;
+ $entry->{$key} = $value;
+ next ATTR;
+ }
+ elsif ( $l =~ m/\G\(/gc ) {
+ my $depth = 1;
+ $value = "";
+ while ( $l =~ m/\G(\(|\)|[^()]+)/gc ) {
+ my $stuff = $1;
+ if ( $stuff eq "(" ) {
+ $depth++;
+ $value .= "(";
+ }
+ elsif ( $stuff eq ")" ) {
+ $depth--;
+ if ( $depth == 0 ) {
+ $entry->{$key} = $value;
+ next ATTR;
+ }
+ $value .= ")";
+ }
+ else {
+ $value .= $stuff;
+ }
+ }
+ m/\G\s*/gc;
+ }
+ else {
+ $self->LastError("Invalid item value in FETCH response: $l");
+ return undef;
+ }
+ }
if ( $self->Uid ) {
- my $uid = $l =~ /\bUID\s+(\d+)/i ? $1 : undef;
- $uid or next;
-
- if ( $uids->{$uid} ) { $entry = $uids->{$uid} }
- else { $uids->{$uid} ||= $entry }
+ $uids->{ $entry->{UID} } = $entry;
}
else {
- my $mid = $l =~ /^\* (\d+) FETCH/i ? $1 : undef;
- $mid or next;
-
- if ( $uids->{$mid} ) { $entry = $uids->{$mid} }
- else { $uids->{$mid} ||= $entry }
- }
-
- foreach my $w (@words) {
- if ( $l =~ /\Q$w\E\s*$/i ) {
- $entry->{$w} = $output->[ $x + 1 ];
- $entry->{$w} =~ s/(?:$CR?$LF)+$//og;
- chomp $entry->{$w};
- }
- elsif (
- $l =~ /\( # open paren followed by ...
- (?:.*\s)? # ...optional stuff and a space
- \Q$w\E\s # escaped fetch field<sp>
- (?:" # then: a dbl-quote
- (\\.| # then bslashed anychar(s) or ...
- [^"]+) # ... nonquote char(s)
- "| # then closing quote; or ...
- \( # ...an open paren
- ([^\)]*) # ... non-close-paren char(s)
- \)| # then closing paren; or ...
- (\S+)) # unquoted string
- (?:\s.*)? # possibly followed by space-stuff
- \) # close paren
- /xi
- )
- {
- $entry->{$w} = defined $1 ? $1 : defined $2 ? $2 : $3;
- }
- }
- }
+ $uids->{$mid} = $entry;
+ }
+
+ for my $word ( keys %$entry ) {
+ next if exists $words{$word};
+
+ if ( my ($stuff) = $word =~ m/^BODY(\[.*)$/ ) {
+ next if exists $words{ "BODY.PEEK" . $stuff };
+ }
+
+ delete $entry->{$word};
+ }
+ }
+
return wantarray ? %$uids : $uids;
}
@@ -2111,16 +2167,20 @@
sub expunge {
my ( $self, $folder ) = @_;
- my $old = $self->Folder || '';
- if ( defined $folder && $folder eq $old ) {
+ return undef unless ( defined $folder or defined $self->Folder );
+
+ my $old = defined $self->Folder ? $self->Folder : '';
+
+ if ( !defined($folder) || $folder eq $old ) {
$self->_imap_command('EXPUNGE')
or return undef;
}
else {
$self->select($folder) or return undef;
my $succ = $self->_imap_command('EXPUNGE');
- $self->select($old) or return undef; # BUG? this should be fatal?
- $succ or return undef;
+
+ # if $old eq '' IMAP4 select should close $folder without EXPUNGE
+ return undef unless ( $self->select($old) and $succ );
}
return wantarray ? $self->History : $self->Results;
@@ -2128,6 +2188,8 @@
sub uidexpunge {
my ( $self, $msgspec ) = ( shift, shift );
+
+ return undef unless $self->has_capability("UIDPLUS");
my $msg =
UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' )
Modified: trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pod?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pod (original)
+++ trunk/libmail-imapclient-perl/lib/Mail/IMAPClient.pod Wed Sep 23 05:25:06 2009
@@ -754,16 +754,14 @@
$imap->close or die "Could not close: $@\n";
-The B<close> method is implemented via the default method and is used
-to close the currently selected folder via the CLOSE IMAP client
-command. According to RFC3501, the CLOSE command performs an implicit
-EXPUNGE, which means that any messages that you've flagged as
-I<\Deleted> (say, with the L</delete_message> method) will now be
-deleted. If you haven't deleted any messages then B<close> can be
-thought of as an "unselect".
-
-Note again that this closes the currently selected folder, not the
-IMAP session.
+The B<close> method is used to close the currently selected folder via
+the CLOSE IMAP client command. According to RFC3501, the CLOSE
+command performs an implicit EXPUNGE, which means that any messages
+that are flagged as I<\Deleted> (i.e. with the L</delete_message>
+method) will now be deleted. If you haven't deleted any messages then
+B<close> can be thought of as an "unselect".
+
+Note: this closes the currently selected folder, not the IMAP session.
See also L</delete_message>, L</expunge>, and RFC3501.
@@ -1063,19 +1061,14 @@
The B<expunge> method accepts one optional argument, a folder name.
It expunges the folder specified as the argument, or the currently
-selected folder if no argument is supplied.
+selected folder (if any) when no argument is supplied.
Although RFC3501 does not permit optional arguments (like a folder
-name) to the EXPUNGE client command, the L</expunge> method does,
-which is especially interesting given that the L</expunge> method
-doesn't technically exist. In case you're curious, expunging a folder
-deletes the messages that you thought were already deleted via
-L</delete_message> but really weren't, which means you have to use a
-method that doesn't exist to delete messages that you thought didn't
-exist. (Seriously, I'm not making any of this stuff up.)
-
-Or you could use the L</close> method, which deselects as well as
-expunges and which likewise doesn't technically exist.
+name) to the EXPUNGE client command, the L</expunge> method does.
+Note: expunging a folder deletes the messages that have the \Deleted
+flag set (i.e. messages flagged via L</delete_message>).
+
+See also the L</close> method, which "deselects" as well as expunges.
=head2 fetch
@@ -1168,27 +1161,12 @@
}
};
-You can specify I<BODY[HEADER.FIELDS ($fieldlist)> as an argument, but
-you should keep the following in mind if you do:
-
-B<1.> You can only specify one argument of this type per call. If you
-need multiple fields, then you'll have to call B<fetch_hashref>
-multiple times, each time specifying a different FETCH attribute but
-the same.
-
-B<2.> Fetch operations that return RFC822 message headers return the
-whole header line, including the field name and the colon. For
-example, if you do a C<$imap-E<gt>fetch_hash("BODY[HEADER.FIELDS
-(Subject)]")>, you will get back subject lines that start with
-"Subject: ".
-
-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
-(and which may even remove the restrictions mentioned in B<1> and
-B<2>, above). Look for more new function in later releases.
+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
@@ -1268,6 +1246,76 @@
Notice that if you just want to list a folder's subfolders (and not
the folder itself), then you need to include the hierarchy separator
character (as returned by the L</separator> method).
+
+=head2 xlist_folders
+
+Example:
+
+ my $xlist = $imap->xlist_folders
+ or die "Could not get xlist folders.\n";
+
+IMAP servers implementing the XLIST extension (such as Gmail)
+designate particular folders to be used for particular functions.
+This is useful in the case where you want to know which folder should
+be used for Trash when the actual folder name can't be predicted
+(e.g. in the case of Gmail, the folder names change depending on the
+user's locale settings).
+
+The B<xlist_folders> method returns a hash listing any "xlist" folder
+names, with the values listing the actual folders that should be used
+for those names. For example, using this method with a Gmail user
+using the English (US) locale might give this output from
+L<Data::Dumper>:
+
+ $VAR1 = {
+ 'Inbox' => 'Inbox',
+ 'AllMail' => '[Gmail]/All Mail',
+ 'Trash' => '[Gmail]/Trash',
+ 'Drafts' => '[Gmail]/Drafts',
+ 'Sent' => '[Gmail]/Sent Mail',
+ 'Spam' => '[Gmail]/Spam',
+ 'Starred' => '[Gmail]/Starred'
+ };
+
+The same list for a user using the French locale might look like this:
+
+ $VAR1 = {
+ 'Inbox' => 'Bo&AO4-te de r&AOk-ception',
+ 'AllMail' => '[Gmail]/Tous les messages',
+ 'Trash' => '[Gmail]/Corbeille',
+ 'Drafts' => '[Gmail]/Brouillons',
+ 'Sent' => '[Gmail]/Messages envoy&AOk-s',
+ 'Spam' => '[Gmail]/Spam',
+ 'Starred' => '[Gmail]/Suivis'
+ };
+
+Mail::IMAPClient recognizes the following "xlist" folder names:
+
+=over 4
+
+=item Inbox
+
+=item AllMail
+
+=item Trash
+
+=item Drafts
+
+=item Sent
+
+=item Spam
+
+=item Starred
+
+=back
+
+These are currently the only ones supported by Gmail. The XLIST
+extension is not documented, and there are no other known
+implementations other than Gmail, so this list is based on what Gmail
+provides.
+
+If the server does not support the XLIST extension, this method
+returns undef.
=head2 has_capability
@@ -2523,6 +2571,9 @@
B<uidexpunge> returns undef on failure.
+If the server does not support the UIDPLUS extension, this method
+returns undef.
+
=head2 uidnext
Example:
Modified: trunk/libmail-imapclient-perl/lib/Mail/IMAPClient/BodyStructure.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-imapclient-perl/lib/Mail/IMAPClient/BodyStructure.pm?rev=44659&op=diff
==============================================================================
--- trunk/libmail-imapclient-perl/lib/Mail/IMAPClient/BodyStructure.pm (original)
+++ trunk/libmail-imapclient-perl/lib/Mail/IMAPClient/BodyStructure.pm Wed Sep 23 05:25:06 2009
@@ -157,7 +157,7 @@
foreach ( @{$self->{$name}} )
{ my $pn = $_->personalname;
my $name = $pn && $pn ne 'NIL' ? "$pn " : '';
- push @list, $pn. '<'.$_->mailboxname .'@'. $_->hostname.'>';
+ push @list, $name . '<' . $_->mailboxname . '@' . $_->hostname . '>';
}
wantarray ? @list
More information about the Pkg-perl-cvs-commits
mailing list