- fix fetch_hash to work with a sequence number containing '*'

- fetch_hash is no longer removing unrequested data (except UID) in returned hashes - new tests for fetch_hash
plobbes · Aug 12, 2015 · f2d2603 · f2d2603
1 parent 99b4ebc
commit f2d2603
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 52 deletions.
diff --git a/Changes b/Changes
@@ -5,9 +5,12 @@ 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.36_02: Sun, Aug  2, 2015 04:41:02 UTC
+version 3.36_03: Wed Aug 12 14:55:33 UTC 2015
+	- rt.cpan.org#105456: fetch_hash fails if sequence number contains '*'
+          [Gilles Lamiral]
 	- rt.cpan.org#91912: selectable broke in 3.29 due to \b around \NoSelect
-	- minor test cleanup
+          [Justin Vallon, Gilles Lamiral]
+	- some documentation, test cleanup and new tests
 
 version 3.35: Fri, Nov 22, 2013  2:18:41 PM
 	- *use Quote() over Massage() to avoid stripping double quotes from arg

diff --git a/lib/Mail/IMAPClient.pm b/lib/Mail/IMAPClient.pm
@@ -7,7 +7,7 @@ use strict;
 use warnings;
 
 package Mail::IMAPClient;
-our $VERSION = '3.36_02';
+our $VERSION = '3.36_03';
 
 use Mail::IMAPClient::MessageSet;
 
@@ -1066,7 +1066,7 @@ sub body_string {
 
         last
           if $head =~
-              /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i;
+          /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i;
     }
 
     unless (@$ref) {
@@ -2140,63 +2140,32 @@ sub fetch_hash {
     # ALL let fetch turn that list of messages into a msgref as needed
     # fetch has similar logic for dealing with message list
     my $msgs = 'ALL';
-    if ( $words[0] ) {
+    if ( defined $words[0] ) {
         if ( ref $words[0] ) {
             $msgs = shift @words;
         }
-        elsif ( $#words > 0 ) {
+        else {
             if ( $words[0] eq 'ALL' ) {
                 $msgs = shift @words;
             }
-            elsif ( $words[0] =~ s/^([,:\d]+)\s*// ) {
+            elsif ( $words[0] =~ s/^([*,:\d]+)\s*// ) {
                 $msgs = $1;
                 shift @words if $words[0] eq "";
             }
         }
     }
 
     # message list (if any) is now removed from @words
-    my $what = join( " ", @words );
+    my $what = "(" . join( " ", @words ) . ")";
 
     # RFC 3501:
     #   fetch = "FETCH" SP sequence-set SP ("ALL" / "FULL" / "FAST" /
     #           fetch-att / "(" fetch-att *(SP fetch-att) ")")
-    my %macro = (
-        "ALL"  => [qw(FLAGS INTERNALDATE RFC822.SIZE ENVELOPE)],
-        "FULL" => [qw(FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY)],
-        "FAST" => [qw(FLAGS INTERNALDATE RFC822.SIZE)],
-    );
-
-    if ( $macro{$what} ) {
-        @words = @{ $macro{$what} };
-    }
-    else {
-        $what = "($what)";
-        my @twords;
-        foreach my $word (@words) {
-            $word = uc($word);
-
-            # server response to BODY[]<10.20> is a field named BODY[]<10>
-            if ( $word =~ /^BODY/ ) {
-                $word =~ s/<(\d+)\.\d+>$/<$1>/;
-
-                # server response to BODY.PEEK[] is a field named BODY[]
-                # BUG? allow for BODY.PEEK in response (historical behavior)
-                if ( $word =~ /^BODY\.PEEK/ ) {
-                    push( @twords, $word );
-                    $word =~ s/^BODY\.PEEK/BODY/;
-                }
-            }
-            unshift( @twords, $word );
-        }
-        @words = @twords;
-    }
-
-    my %words = map { $_ => 1 } @words;
-
     my $output = $self->fetch( $msgs, $what )
       or return undef;
 
+    my $asked_for_uid = $what =~ /[\s(]UID[)\s]/i;
+
     while ( my $l = shift @$output ) {
         next if $l !~ m/^\*\s(\d+)\sFETCH\s\(/g;
         my ( $mid, $entry ) = ( $1, {} );
@@ -2259,18 +2228,15 @@ sub fetch_hash {
             }
         }
 
+        # NOTE: old code tried to remove any "unrequested" data in $entry
+        # - UID is sometimes not explicitly requested, are there others?
         if ( $self->Uid ) {
             $uids->{ $entry->{UID} } = $entry;
+            delete $entry->{UID} unless $asked_for_uid;
         }
         else {
             $uids->{$mid} = $entry;
         }
-
-        # remove things not asked for (i.e. UID/$mid)
-        for my $word ( keys %$entry ) {
-            next if ( exists $words{$word} );
-            delete $entry->{$word};
-        }
     }
 
     return wantarray ? %$uids : $uids;

diff --git a/t/basic.t b/t/basic.t
@@ -33,7 +33,7 @@ BEGIN {
 
     @missing
       ? plan skip_all => "missing value for: @missing"
-      : plan tests    => 92;
+      : plan tests    => 100;
 }
 
 BEGIN { use_ok('Mail::IMAPClient') or exit; }
@@ -169,6 +169,16 @@ SKIP: {
     my $d = " 1-Jan-2011 01:02:03 -0500";
     my $uid = $imap->append_string( $target, $testmsg, undef, $d );
     ok( defined $uid, "append test message to $target with date (uid=$uid)" );
+
+    # hash results do not have UID unless requested
+    my $h1 = $imap->fetch_hash( $uid, "RFC822.SIZE" );
+    is( ref($h1), "HASH", "fetch_hash($uid,RFC822.SIZE)" );
+    is( scalar keys %$h1, 1, "fetch_hash: fetched one msg (as requested)" );
+    is( !exists $h1->{$uid}->{UID}, 1, "fetch_hash: no UID (not requested)" );
+
+    $h1 = $imap->fetch_hash( $uid, "UID RFC822.SIZE" );
+    is( exists $h1->{$uid}->{UID}, 1, "fetch_hash: has UID (as requested)" );
+
     ok( $imap->delete_message($uid), "delete_message $uid" );
     ok( $imap->uidexpunge($uid),     "uidexpunge $uid" );
 
@@ -289,11 +299,29 @@ ok( $uid2, "copy $target2" );
 my @res = $imap->fetch( 1, "RFC822.TEXT" );
 ok( scalar @res, "fetch rfc822" );
 
-my $res1 = $imap->fetch_hash("RFC822.SIZE");
-is( ref($res1), "HASH", "fetch_hash(RFC822.SIZE)" );
+{
+    my $h1 = $imap->fetch_hash("RFC822.SIZE");
+    is( ref($h1), "HASH", "fetch_hash(RFC822.SIZE)" );
+
+    my $id = ( sort { $a <=> $b } keys %$h1 )[0];
+    my $h2 = $imap->fetch_hash( $id, "RFC822.SIZE" );
+    is( ref($h2), "HASH", "fetch_hash($id,RFC822.SIZE)" );
+    is( scalar keys %$h2, 1, "fetch_hash($id,RFC822.SIZE) => fetched one msg" );
+}
 
-my $res2 = $imap->fetch_hash( 1, "RFC822.SIZE" );
-is( ref($res2), "HASH", "fetch_hash(1,RFC822.SIZE)" );
+{
+    my $seq = "1:*";
+    my @dat = ( qw(RFC822.SIZE INTERNALDATE) );
+
+    my $h1 = $imap->fetch_hash( $seq, @dat );
+    is( ref($h1), "HASH", "fetch_hash($seq, " . join(", ", @dat) . ")" );
+
+    # verify legacy and less desirable use case still works
+    my $h2 = $imap->fetch_hash("$seq @dat");
+    is( ref($h2), "HASH", "fetch_hash('$seq @dat')" );
+
+    is_deeply( $h1, $h2, "fetch_hash same result with array or string args" );
+}
 
 my $h = $imap->parse_headers( 1, "Subject" );
 ok( $h, "got subject" );