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