| Subject: | Support for partial data responses in fetch_hash |
Hello,
I need to perform an IMAP fetch using the BODY[]<M.N> "partial" IMAP feature, but
Mail::IMAPClient was unable to parse the response. This is because the IMAP response for a fetch
of BODY[]<M.N> is BODY[]<M> (no N).
I have attached a patch for version 3.30 that adds support for parsing that type of response. The
patch includes tests. Could you please incorporate it into the official Mail::IMAPClient
distribution?
Thanks,
Philip Garrett
| Subject: | partial-fetch-response.patch |
diff --git a/lib/Mail/IMAPClient.pm b/lib/Mail/IMAPClient.pm
index ef09340..99eaaf2 100644
--- a/lib/Mail/IMAPClient.pm
+++ b/lib/Mail/IMAPClient.pm
@@ -2142,11 +2142,24 @@ sub fetch_hash {
# message list (if any) is now removed from @words
my $what = join ' ', @words;
+ my @want;
for (@words) {
s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i;
s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i;
+
+ my $accept = uc $_;
+ push @want, $accept;
+
+ # server responds to BODY.PEEK[] with a field named BODY[]
+ $accept =~ s{^BODY\.PEEK}{BODY};
+ push @want, $accept;
+
+ # server responds to BODY[]<10.20> with a field named BODY[]<10>
+ $accept =~ s{<(\d+)\.\d+>$}{<$1>};
+ push @want, $accept;
}
- my %words = map { uc($_) => 1 } @words;
+ my $is_wanted = join('|', map { quotemeta } @want);
+ $is_wanted = qr{(?:$is_wanted)};
my $output = $self->fetch( $msgs, "($what)" )
or return undef;
@@ -2157,7 +2170,7 @@ s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i;
my ( $key, $value );
ATTR:
while ( $l and $l !~ m/\G\s*\)\s*$/gc ) {
- if ( $l =~ m/\G\s*([^\s\[]+(?:\[[^\]]*\])?)\s*/gc ) {
+ if ( $l =~ m/\G\s*([^\s\[]+(?:\[[^\]]*\])?(?:<[^>]*>)?)\s*/gc ) {
$key = uc($1);
}
elsif ( !defined $key ) {
@@ -2221,13 +2234,9 @@ s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i;
}
for my $word ( keys %$entry ) {
- next if exists $words{$word};
-
- if ( my ($stuff) = $word =~ m/^BODY(\[.*)$/ ) {
- next if exists $words{ "BODY.PEEK" . $stuff };
+ if ($word !~ $is_wanted) {
+ delete $entry->{$word};
}
-
- delete $entry->{$word};
}
}
diff --git a/t/fetch_hash.t b/t/fetch_hash.t
index c998887..37417ed 100644
--- a/t/fetch_hash.t
+++ b/t/fetch_hash.t
@@ -9,7 +9,7 @@
use strict;
use warnings;
-use Test::More tests => 20;
+use Test::More tests => 22;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
@@ -111,6 +111,18 @@ my @tests = (
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
],
[
+ "BODY[]<0.1024> requests match BODY[]<0> responses",
+ [q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n"],
+ [ [1], qw(BODY[]<0.1024>) ],
+ { "1" => { "BODY[]<0>" => q{foo}, }, },
+ ],
+ [
+ "BODY.PEEK[]<0.1024> requests match BODY[]<0> responses",
+ [q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n"],
+ [ [1], qw(BODY.PEEK[]<0.1024>) ],
+ { "1" => { "BODY[]<0>" => q{foo}, }, },
+ ],
+ [
"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"},