r57669 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod lib/Mail/IMAPClient/BodyStructure.pm prepare_dist t/basic.t t/bodystructure.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Sat May 8 12:08:59 UTC 2010


Author: ansgar-guest
Date: Sat May  8 12:08:44 2010
New Revision: 57669

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57669
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.24)

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/lib/Mail/IMAPClient/BodyStructure.pm
    branches/upstream/libmail-imapclient-perl/current/prepare_dist
    branches/upstream/libmail-imapclient-perl/current/t/basic.t
    branches/upstream/libmail-imapclient-perl/current/t/bodystructure.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=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Sat May  8 12:08:44 2010
@@ -4,6 +4,34 @@
 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.24: Fri May  7 17:02:35 EDT 2010
+	- rt.cpan.org#48912: wrong part numbers in multipart messages
+	  [Dmitry Bigunyak, Gabor Leszlauer]
+	- fix Mail::IMAPClient::BodyStructure::bodystructure to
+	  properly assign parts for messages using multipart and also
+	  include .TEXT parts as well (still not including top level
+	  HEADER and TEXT though - bug?)
+	- allow _load_module() to set $@ and LastError if module load fails
+	- rt.cpan.org#55527: [no] disconnect during DESTROY
+	  [Stefan Seifert]
+	- updated logout documentation to correctly state that DESTROY
+	  is not used to force an automatic logout on DESTROY despite
+	  documentation that indicated otherwise
+	- update append* documentation to match current implementation
+	- rt.cpan.org#55898: append_file can send too many bytes
+	  [Jeremy Robst]
+	- avoid append_file corner cases operating on lines instead of buffers
+	- use binmode on filehandle in append_file
+	- add tests to t/basic.t for append_file
+	- rt.cpan.org#57048: _quote_search() using $_ in loop instead of $v
+	  [Matthaus Kiem]
+	- added examples/idle.pl program showing use of idle and idle_data
+	- idle_data() should not read/block after server returns data
+	  [Marc Thielemann]
+	- idle_data() _get_response regexp updated to not match errors
+	- idle_data() now uses a timeout of 0 by default as documented
+	- _get_response() now checks for defined($code) to allow $code==0
 
 version 3.23: Fri Jan 29 00:39:27 EST 2010
 	- new beta idle_data() method to retrieve untagged messages during idle

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=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Sat May  8 12:08:44 2010
@@ -1,22 +1,33 @@
-# 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.23
-version_from: lib/Mail/IMAPClient.pm
-installdirs:  site
+--- #YAML:1.0
+name:               Mail-IMAPClient
+version:            3.24
+abstract:           IMAP4 client library
+author:
+    - Phil Lobbes <phil at zimbra.com>
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
-    Carp:                          0
-    Errno:                         0
-    Fcntl:                         0
-    File::Temp:                    0
-    IO::File:                      0
-    IO::Select:                    0
-    IO::Socket:                    0
-    IO::Socket::INET:              1.26
-    List::Util:                    0
-    MIME::Base64:                  0
-    Parse::RecDescent:             1.94
-    Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+    Carp:               0
+    Errno:              0
+    Fcntl:              0
+    File::Temp:         0
+    IO::File:           0
+    IO::Select:         0
+    IO::Socket:         0
+    IO::Socket::INET:   1.26
+    List::Util:         0
+    MIME::Base64:       0
+    Parse::RecDescent:  1.94
+    Test::More:         0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

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=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Sat May  8 12:08:44 2010
@@ -5,7 +5,7 @@
 use warnings;
 
 package Mail::IMAPClient;
-our $VERSION = '3.23';
+our $VERSION = '3.24';
 
 use Mail::IMAPClient::MessageSet;
 
@@ -57,7 +57,6 @@
     my $modkey = shift;
     my $module = $Load_Module{$modkey} || $modkey;
 
-    local ($@);    # avoid stomping on global $@
     eval "require $module";
     if ($@) {
         $self->LastError("Unable to load '$module': $@");
@@ -1227,23 +1226,30 @@
 
 sub idle_data {
     my $self    = shift;
-    my $timeout = defined( $_[0] ) ? shift : 0.025;
+    my $timeout = scalar(@_) ? shift : 0;
     my $socket  = $self->Socket;
 
     # current index in Results array
     my $trans_c1 = $self->_next_index;
 
     # look for all untagged responses
-    my $rc;
-    while (
-        (
-            $rc =
-            $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout )
-        ) > 0
-      )
-    {
-        $self->_get_response( '*', qr/\S+/ ) or return undef;
-    }
+    my ( $rc, $ret );
+
+    do {
+        $ret =
+          $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout );
+
+        # set rc on first pass or on errors
+        $rc = $ret if ( !defined($rc) or $ret < 0 );
+
+        # not using /\S+/ because that can match 0 in "* 0 RECENT"
+        # leading the library to act as if things failed
+        if ( $ret > 0 ) {
+            $self->_get_response( '*', qr/(?!BAD|BYE|NO)(?:\d+\s+\w+|\S+)/ )
+              or return undef;
+            $timeout = 0;    # check for more data without blocking!
+        }
+    } while $ret > 0;
 
     # select returns -1 on errors
     return undef if $rc < 0;
@@ -1425,7 +1431,7 @@
     my @readopt = defined( $opt->{outref} ) ? ( $opt->{outref} ) : ();
 
     my ( $count, $out, $code, $byemsg ) = ( $self->Count, [], undef, undef );
-    until ($code) {
+    until ( defined($code) ) {
         my $output = $self->_read_line(@readopt) or return undef;
         $out = $output;    # keep last response just in case
 
@@ -1457,7 +1463,7 @@
         }
     }
 
-    if ($code) {
+    if ( defined($code) ) {
         $code =~ s/$CR?$LF?$//o;
         $code = uc($code) unless ( $good and $code eq $good );
 
@@ -2627,7 +2633,7 @@
         if ( ref($v) eq "SCALAR" ) {
             push( @ret, $$v );
         }
-        elsif ( exists $SEARCH_KEYS{ uc($_) } ) {
+        elsif ( exists $SEARCH_KEYS{ uc($v) } ) {
             push( @ret, $v );
         }
         elsif ( @args == 1 ) {
@@ -2959,6 +2965,8 @@
         return undef;
     }
 
+    binmode($fh);
+
     my $date;
     if ( $fh and $use_filetime ) {
         my $f = $self->Rfc2060_datetime( ( stat($fh) )[9] );
@@ -2990,9 +2998,30 @@
     my $count = $self->Count;
 
     # Now send the message itself
-    my $buffer;
-    while ( $fh->sysread( $buffer, APPEND_BUFFER_SIZE ) ) {
-        $buffer =~ s/\r?\n/$CRLF/og;
+    my ( $buffer, $buflen ) = ( "", 0 );
+    until ( !$buflen and eof($fh) ) {
+
+        if ( $buflen < APPEND_BUFFER_SIZE ) {
+          FILLBUFF:
+            while ( my $line = <$fh> ) {
+                $line =~ s/\r?\n$/$CRLF/;
+                $buffer .= $line;
+                $buflen = length($buffer);
+                last FILLBUFF if ( $buflen >= APPEND_BUFFER_SIZE );
+            }
+        }
+
+        # exit loop entirely if we are out of data
+        last unless $buflen;
+
+        # save anything over desired buffer size for next iteration
+        my $savebuff =
+          ( $buflen > APPEND_BUFFER_SIZE )
+          ? substr( $buffer, APPEND_BUFFER_SIZE )
+          : undef;
+
+        # reduce buffer to desired size
+        $buffer = substr( $buffer, 0, APPEND_BUFFER_SIZE );
 
         $self->_record(
             $count,
@@ -3007,6 +3036,10 @@
             $self->LastError( "Error appending message: " . $self->LastError );
             return undef;
         }
+
+        # retain any saved data and continue loop
+        $buffer = defined($savebuff) ? $savebuff : "";
+        $buflen = length($buffer);
     }
 
     # finish off append

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=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Sat May  8 12:08:44 2010
@@ -549,7 +549,7 @@
 
 Example:
 
-  my $uid = $imap->append($folder,$msg_text)
+  my $uid = $imap->append( $folder, $msg_text )
     or die "Could not append: ", $imap->LastError;
 
 The B<append> method adds a message to the specified folder.  It takes
@@ -557,17 +557,12 @@
 the text of the message (including headers).  Additional arguments are
 added to the message text, separated with <CR><LF>.
 
-The B<append> method returns the UID of the new message (a true value)
-if successful, or C<undef> if not, if the IMAP server has the UIDPLUS
-capability.  If it doesn't then you just get true on success and undef
-on failure.
-
-Note that many servers will get really ticked off if you try to append
-a message that contains "bare newlines", which is the titillating term
-given to newlines that are not preceded by a carriage return.  To
-protect against this, B<append> will insert a carriage return before
-any newline that is "bare".  If you don't like this behavior then you
-can avoid it by not passing naked newlines to B<append>.
+On success, the B<append> method returns the UID of the new message
+(if the server has the UIDPLUS capability) or a true value otherwise.
+On error, C<undef> is returned and L</LastError> will be set.
+
+To protect against "bare newlines", B<append> will insert a carriage
+return before any newline that is "bare".
 
 Note that B<append> does not allow you to specify the internal date or
 initial flags of an appended message.  If you need this capability
@@ -580,41 +575,37 @@
   my $new_msg_uid = $imap->append_file(
       $folder,
       $filename,
-      [ $input_record_separator, flags, date ] # optional
+      [ undef, flags, date ] # optional
   ) or die "Could not append_file: ", $imap->LastError;
 
 The B<append_file> method adds a message to the specified folder.  It
 takes two arguments, the name of the folder to append the message to,
 and the file name of an RFC822-formatted message.
 
-An optional third argument is the value to use for
-C<input_record_separator>.  The default is to use "" for the first
-read (to get the headers) and "\n" for the rest.  Any valid value for
-C<$/> is acceptable, even the funky stuff, like C<\1024>.  (See
-L<perlvar|perlvar> for more information on C<$/>).  (The brackets in
-the example indicate that this argument is optional; they do not mean
-that the argument should be an array reference.)
-
-The B<append_file> method returns the UID of the new message (a true
-value) if successful, or C<undef> if not, if the IMAP server has the
-UIDPLUS capability.  If it doesn't then you just get true on success
-and undef on failure.  If you supply a filename that doesn't exist
-then you get an automatic C<undef>.  The L</LastError> method will
-remind you of this if you forget that your file doesn't exist but
-somehow manage to remember to check L</LastError>.
-
-In case you're wondering, B<append_file> is provided mostly as a way
-to allow large messages to be appended without having to have the
-whole file in memory.  It uses the C<-s> operator to obtain the size
-of the file and then reads and sends the contents line by line (or
-not, depending on whether you supplied that optional third argument).
+Note: The brackets in the example indicate optional arguments; they do
+not mean that the argument should be an array reference.
+
+On success, the B<append_file> method returns the UID of the new
+message (if the server has the UIDPLUS capability) or a true value
+otherwise.  On error, C<undef> is returned and L</LastError> will be
+set.
+
+To protect against "bare newlines", B<append_file> will insert a
+carriage return before any newline that is "bare".
+
+The B<append_file> method provides a mechanism for allowing large
+messages to be appended without holding the whole file in memory.
+
+Version note: In 2.x an optional third argument to use for
+C<input_record_separator> was allowed, however this argument is
+ignored/not supported as of 3.x.
 
 =head2 append_string
 
 Example:
 
    # brackets indicate optional arguments (not array refs):
-   my $uid = $imap->append_string( $folder, $text [,$flags [,$date ] ])
+   my $uid = $imap->append_string( $folder, $text [ ,$flags [ ,$date ] ] )
        or die "Could not append_string: $@\n";
 
 The B<append_string> method adds a message to the specified folder.
@@ -636,18 +627,13 @@
 If you want to specify a date/time but you don't want any flags then
 specify I<undef> as the third argument.
 
-The B<append_string> method returns the UID of the new message (a true
-value) if successful, or C<undef> if not, if the IMAP server has the
-UIDPLUS capability.  If it doesn't then you just get true on success
-and undef on failure.
-
-Note that many servers will get really ticked off if you try to append
-a message that contains "bare newlines", which is the titillating term
-given to newlines that are not preceded by a carriage return.  To
-protect against this, B<append_string> will insert a carriage return
-before any newline that is "bare".  If you don't like this behavior
-then you can avoid it by not passing naked newlines to
-B<append_string>.
+On success, the B<append_string> method returns the UID of the new
+message (if the server has the UIDPLUS capability) or a true value
+otherwise.  On error, C<undef> is returned and L</LastError> will be
+set.
+
+To protect against "bare newlines", B<append_string> will insert a
+carriage return before any newline that is "bare".
 
 =head2 authenticate
 
@@ -1583,8 +1569,16 @@
 the IMAPClient object, thus the L</connect> and L</login> methods can
 be used to establish a new IMAP session.
 
-Per RFC2683, Mail::IMAPClient will attempt to log out of the server
-during B<DESTROY> if the object is in the L</Connected> state.
+Note that RFC2683 section 3.1.2 (Severed connections) makes some
+recommendations on how IMAP clients should behave.  It is up to the
+user of this module to decide on the preferred behavior and code
+accordingly.
+
+Version note: documentation (from 2.x through 3.23) claimed that
+Mail::IMAPClient would attempt to log out of the server during
+B<DESTROY> if the object is in the L</Connected> state.  This
+documentation was apparently incorrect from at least 2.2.2 and
+possibly earlier versions on up.
 
 =head2 lsub
 

Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure.pm?rev=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure.pm Sat May  8 12:08:44 2010
@@ -3,6 +3,9 @@
 
 package Mail::IMAPClient::BodyStructure;
 use Mail::IMAPClient::BodyStructure::Parse;
+
+# BUG?: old code used name "HEAD" instead of "HEADER", change?
+my $HEAD = "HEAD";
 
 # my has file scope, not limited to package!
 my $parser = Mail::IMAPClient::BodyStructure::Parse->new
@@ -17,7 +20,7 @@
        or return undef;
 
     $self->{_prefix} = "";
-    $self->{_id}     = exists $self->{bodystructure} ? 'HEAD' : 1;
+    $self->{_id}     = exists $self->{bodystructure} ? $HEAD : 1;
     $self->{_top}    = 1;
 
     bless $self, ref($class)||$class;
@@ -63,9 +66,10 @@
     my @parts;
     $self->{PartsList} = \@parts;
 
+    # BUG?: should this default to ($HEAD, TEXT)
     unless(exists $self->{bodystructure})
     {   $self->{PartsIndex}{1} = $self;
-        @parts = ("HEAD", 1);
+        @parts = ($HEAD, 1);
         return wantarray ? @parts : \@parts;
     }
 
@@ -75,7 +79,7 @@
         $self->{PartsIndex}{$id} = $p ;
         my $type = uc $p->bodytype || '';
 
-        push @parts, "$id.HEAD"
+        push @parts, "$id.$HEAD"
             if $type eq 'MESSAGE';
     }
 
@@ -88,8 +92,8 @@
     my @parts;
 
     if($self->{_top})
-    {   $self->{_id}     ||= "HEAD";
-        $self->{_prefix} ||= "HEAD";
+    {   $self->{_id}     ||= $HEAD;
+        $self->{_prefix} ||= $HEAD;
         $partno = 0;
         foreach my $b ( @{$self->{bodystructure}} )
         {   $b->{_id}     = ++$partno;
@@ -102,10 +106,19 @@
     my $prefix = $self->{_prefix} || "";
     $prefix    =~ s/\.?$/./;
 
+    # in a multipart message each subpart is one level "higher"
+    $prefix =~ s/\.\d+\.$/./ if ($self->{bodytype} eq 'MULTIPART');
+
     foreach my $p ( @{$self->{bodystructure}} )
     {   $partno++;
+
         $p->{_prefix} = "$prefix$partno";
-        $p->{_id}   ||= "$prefix$partno";
+
+        # BUG?: old code didn't add .TEXT sections, should we skip these?
+        my $pno = $partno;
+        $pno = "TEXT" if ($partno == 1 and $self->{bodytype} eq 'MESSAGE');
+        $p->{_id}   ||= "$prefix$pno";
+
         push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
     }
 
@@ -117,9 +130,10 @@
     return $self->{_id}
         if exists $self->{_id};
 
-    return "HEAD"
+    return $HEAD
         if $self->{_top};
 
+    # BUG?: can this be removed? ... seems wrong
     if ($self->{bodytype} eq 'MULTIPART')
     {   my $p = $self->{_id} || $self->{_prefix};
         $p =~ s/\.$//;

Modified: branches/upstream/libmail-imapclient-perl/current/prepare_dist
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/prepare_dist?rev=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/prepare_dist (original)
+++ branches/upstream/libmail-imapclient-perl/current/prepare_dist Sat May  8 12:08:44 2010
@@ -4,10 +4,14 @@
 use strict;
 
 use Parse::RecDescent 1.94;
-use File::Slurp qw/read_file/;
 use File::Copy  qw/move/;
 
-sub build_parser($$);
+sub read_file {
+    my $file = shift;
+    local( $/, *FH );
+    open( FH, $file ) or return undef;
+    return <FH>;
+}
 
 build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar'
            , 'Mail::IMAPClient::BodyStructure::Parse';
@@ -15,8 +19,8 @@
 build_parser 'lib/Mail/IMAPClient/Thread.grammar'
            , 'Mail::IMAPClient::Thread';
 
-sub build_parser($$)
-{   my ($grammarfn, $package) = @_;
+sub build_parser {
+    my ($grammarfn, $package) = @_;
 
     print "* building $package\n";
 

Modified: branches/upstream/libmail-imapclient-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/t/basic.t?rev=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/basic.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/basic.t Sat May  8 12:08:44 2010
@@ -32,7 +32,7 @@
 
     @missing
       ? plan skip_all => "missing value for: @missing"
-      : plan tests    => 67;
+      : plan tests    => 77;
 }
 
 BEGIN { use_ok('Mail::IMAPClient') or exit; }
@@ -74,10 +74,19 @@
 the installation of the Mail::IMAPClient module from CPAN.
 __TEST_MSG
 
-ok( $imap->noop, "noop" );
+ok( $imap->noop,                    "noop" );
+ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
 
 my $sep = $imap->separator;
 ok( defined $sep, "separator is '$sep'" );
+
+{
+    my $list = $imap->list();
+    is( ref($list), "ARRAY", "list" );
+
+    my $lsub = $imap->lsub();
+    is( ref($lsub), "ARRAY", "lsub" );
+}
 
 my $ispar = $imap->is_parent('INBOX');
 my ( $target, $target2 ) =
@@ -88,15 +97,78 @@
 ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" );
 
 ok( $imap->select('inbox'), "select inbox" );
-ok( $imap->create($target), "create target" );
-
-{
-    my $list = $imap->list();
-    is( ref($list), "ARRAY", "list" );
-
-    my $lsub = $imap->lsub();
-    is( ref($lsub), "ARRAY", "lsub" );
-
+
+# test append_file
+my $append_file_size;
+{
+    my ( $afh, $afn ) = tempfile UNLINK => 1;
+
+    # write message to autoflushed file handle since we keep $afh around
+    my $oldfh = select($afh);
+    $| = 1;
+    select($oldfh);
+    print( $afh $testmsg ) or die("print testmsg failed");
+    cmp_ok( -s $afn, '>', 0, "tempfile has size" );
+
+    ok( $imap->create($target), "create target" );
+
+    my $uid = $imap->append_file( $target, $afn );
+    ok( defined $uid, "append_file test message to $target" );
+
+    ok( $imap->select($target), "select $target" );
+
+    my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
+    my $size = $imap->size($msg);
+
+    cmp_ok( $size, '>', 0, "has size $size" );
+
+    my $string = $imap->message_string($msg);
+    ok( defined $string, "returned string" );
+
+    cmp_ok( length($string), '==', $size, "string matches server size" );
+    ok( $imap->delete($target), "delete folder $target" );
+
+    $append_file_size = $size;
+}
+
+# test append (string)
+{
+    ok( $imap->create($target), "create target" );
+
+    my $uid = $imap->append( $target, $testmsg );
+    ok( defined $uid, "append test message to $target" );
+
+    ok( $imap->select($target), "select $target" );
+
+    my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
+    my $size = $imap->size($msg);
+
+    cmp_ok( $size, '>', 0, "has size $size" );
+
+    my $string = $imap->message_string($msg);
+    ok( defined $string, "returned string" );
+
+    cmp_ok( length($string), '==', $size, "string matches server size" );
+
+    {
+        my ( $fh, $fn ) = tempfile UNLINK => 1;
+        ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
+
+        cmp_ok( -s $fn, '==', $size, "correct size" );
+    }
+
+    cmp_ok( $size, '==', $append_file_size, "size matches string/file" );
+
+    # save message/folder for use below...
+    #OFF ok( $imap->delete($target), "delete folder $target" );
+}
+
+#OFF ok( $imap->create($target), "create target" );
+ok( $imap->exists($target),  "exists $target" );
+ok( $imap->create($target2), "create $target2" );
+ok( $imap->exists($target2), "exists $target2" );
+
+{
     ok( $imap->subscribe($target), "subscribe target" );
 
     my $sub1 = $imap->subscribed();
@@ -106,9 +178,9 @@
 
     my $sub2 = $imap->subscribed();
     is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" );
-
-    ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
-}
+}
+
+ok( $imap->select($target), "select $target" );
 
 my $fwquotes = qq($target${sep}has "quotes");
 if ( !$imap->is_parent($target) ) {
@@ -130,32 +202,6 @@
     else { ok( 0, "failed creation with quotes" ) }
     ok( 1, "skipping 1/2 tests" );
     ok( 1, "skipping 2/2 tests" );
-}
-
-ok( $imap->exists($target),  "exists $target" );
-ok( $imap->create($target2), "create $target2" );
-ok( $imap->exists($target2), "exists $target2" );
-
-my $uid = $imap->append( $target, $testmsg );
-ok( defined $uid, "append test message to $target" );
-
-ok( $imap->select($target), "select $target" );
-
-my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
-my $size = $imap->size($msg);
-
-cmp_ok( $size, '>', 0, "has size $size" );
-
-my $string = $imap->message_string($msg);
-ok( defined $string, "returned string" );
-
-cmp_ok( length($string), '==', $size, "string has size" );
-
-{
-    my ( $fh, $fn ) = tempfile UNLINK => 1;
-    ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
-
-    cmp_ok( -s $fn, '==', $size, "correct size" );
 }
 
 my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" );

Modified: branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t?rev=57669&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t Sat May  8 12:08:44 2010
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 11;
+use Test::More tests => 18;
 
 BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; }
 
@@ -16,7 +16,7 @@
 is( $bsobj->bodysubtype, 'PLAIN', 'bodysubtype' );
 
 my $bs2 = <<'END_OF_BS2';
-(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9 at generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c at one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
+(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9 at generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c at one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
 END_OF_BS2
 
 $bsobj = Mail::IMAPClient::BodyStructure->new($bs2);
@@ -27,23 +27,25 @@
 is(
     join( "#", $bsobj->parts ),
 
-    # Better parsing in version 3.03, changed this outcome
-    # "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2"
-"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2",
+    # Parsing in version 3.03, changed outcome from
+    #  this: "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2"
+    #  to:   "1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2"
+    # Patches to BodyStructure.pm in 3.24 changed it to this:
+    "1#2#2.HEAD#2.TEXT#2.1#2.2#2.2.HEAD#2.2.TEXT#2.2.1#2.2.1#2.2.2",
     'parts'
 );
 
 my $bs3 = <<'END_OF_BS3';
 FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1")
 NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset"
-"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE"))
+"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE"))
 END_OF_BS3
 
 $bsobj = Mail::IMAPClient::BodyStructure->new($bs3);
 ok( defined $bsobj, 'parsed third' );
 
 my $bs4 = <<'END_OF_BS4';
-* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin at activtrades.com" NIL "polettld" "ensma.fr")) (("admin at activtrades.com" NIL "polettld" "ensma.fr")) (("admin at activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail at cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT"))
+* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin at activtrades.com" NIL "polettld" "ensma.fr")) (("admin at activtrades.com" NIL "polettld" "ensma.fr")) (("admin at activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail at cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT"))
 END_OF_BS4
 
 $bsobj = Mail::IMAPClient::BodyStructure->new($bs4);
@@ -51,8 +53,39 @@
 
 # test bodyMD5, contributed by Micheal Stok
 my $bs5 = <<'END_OF_BS5';
-* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL))
+* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL))
 END_OF_BS5
 
+my @exp;
 $bsobj = Mail::IMAPClient::BodyStructure->new($bs5);
+ at exp = qw(1 1.1 1.2 2);
 ok( defined $bsobj, 'parsed fifth' );
+is_deeply( [ $bsobj->parts ], \@exp, 'bs5 parts' )
+  or diag( join(" ", $bsobj->parts ) );
+
+#
+my $bs6 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "8bit" 82 6 NIL NIL NIL NIL)("message" "rfc822" ("name" "this is internal letter.eml") NIL NIL "7bit" 243436 ("Mon, 24 Aug 2009 10:51:22 +0400" "this is internal letter" ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "dima" "adriver.ru")) NIL NIL NIL "<4A92386A.9080307 at inbox.ru>") (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "7bit" 116 7 NIL NIL NIL NIL)("text" "xml" ("name" "mediaplan.xml" "charset" "us-ascii") NIL NIL "base64" 31412 424 NIL ("inline" ("filename" "mediaplan.xml")) NIL NIL)("application" "zip" ("name" "banners2.zip") NIL NIL "base64" 209942 NIL ("inline" ("filename" "banners2.zip")) NIL NIL) "mixed" ("boundary" "------------070804080502030807020509") NIL NIL NIL) 3326 NIL ("inline" ("filename" "this is internal letter.eml")) NIL NIL) "mixed" ("boundary" "------------070704030806000803040203") NIL NIL NIL))};
+
+$bsobj = Mail::IMAPClient::BodyStructure->new($bs6);
+ at exp   = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.3);
+ok( defined $bsobj, 'parsed sixth' );
+is_deeply( [ $bsobj->parts ], \@exp, 'bs6 parts' )
+  or diag( join(" ", $bsobj->parts ) );
+
+#
+my $bs7 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri,07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707 at local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654 at local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary""==-=-=") NIL NIL NIL))};
+
+$bsobj = Mail::IMAPClient::BodyStructure->new($bs7);
+ at exp   = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.TEXT);
+ok( defined $bsobj, 'parsed seventh' );
+is_deeply( [ $bsobj->parts ], \@exp, 'bs7 parts' )
+  or diag( join(" ", $bsobj->parts ) );
+
+#
+my $bs8 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "My forwarded message" "7bit" 2833 ("Fri, 07 May 2010 01:55:40 -0400" "outer msg" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25030.1273211740 at local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri, 07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707 at local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654 at local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary" "==-=-=") NIL NIL NIL) 91 NIL ("inline" ("filename" "52")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 30 2 NIL NIL NIL NIL)("application" "octet-stream" NIL NIL "My attachment" "7bit" 76 NIL ("attachment" ("filename" ".signature.cell")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL) "mixed" ("boundary" "===-=-=") NIL NIL NIL))};
+
+$bsobj = Mail::IMAPClient::BodyStructure->new($bs8);
+ at exp   = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.TEXT 2.2.1 2.2.2 2.2.2.HEAD 2.2.2.TEXT 3 4 5);
+ok( defined $bsobj, 'parsed eighth' );
+is_deeply( [ $bsobj->parts ], \@exp, 'bs8 parts' )
+  or diag( join(" ", $bsobj->parts ) );




More information about the Pkg-perl-cvs-commits mailing list