r29682 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod lib/Mail/IMAPClient/BodyStructure/Parse.grammar lib/Mail/IMAPClient/BodyStructure/Parse.pm t/bodystructure.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Thu Jan 15 22:21:17 UTC 2009


Author: ansgar-guest
Date: Thu Jan 15 22:21:13 2009
New Revision: 29682

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

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/Parse.grammar
    branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.pm
    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=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Thu Jan 15 22:21:13 2009
@@ -2,6 +2,21 @@
 == Revision History for Mail::IMAPClient
 All changes from 2.99_01 upward are made by Mark Overmeer.  The changes
 before that are applied by David Kernen
+
+version 3.13: Thu Jan 15 10:29:04 CET 2009
+
+	Fixes:
+
+	- "othermessage" in bodystructure parser should expect an MD5,
+	  not bodyparams.  Fix and test(!) by [Michael Stok]
+
+	Improvement:
+
+	- minor simplifications in code of run() and _imap_command()
+
+	- get_bodystructure trace message fix [Michael Stok]
+
+	- add Domain option for NTLM authentication.
 
 version 3.12: Mon Nov 24 15:34:58 CET 2008
 

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=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Thu Jan 15 22:21:13 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Mail-IMAPClient
-version:             3.12
+version:             3.13
 abstract:            IMAP4 client library
 license:             ~
 author:              ~

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=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Thu Jan 15 22:21:13 2009
@@ -1,8 +1,11 @@
+
+# _{name} methods are undocumented and meant to be private.
+
 use warnings;
 use strict;
 
 package Mail::IMAPClient;
-our $VERSION = '3.12';
+our $VERSION = '3.13';
 
 use Mail::IMAPClient::MessageSet;
 
@@ -61,10 +64,10 @@
 BEGIN {
    # set-up accessors
    foreach my $datum (
-     qw(State Port Server Folder Peek User Password Timeout Buffer
-        Debug Count Uid Debug_fh Maxtemperrors Authuser Authmechanism Authcallback
+     qw(State Port Server Folder Peek User Password Timeout Buffer Debug
+        Count Uid Debug_fh Maxtemperrors Authuser Authmechanism Authcallback
         Ranges Readmethod Showcredentials Prewritemethod Ignoresizeerrors
-        Supportedflags Proxy))
+        Supportedflags Proxy Domain))
    { no strict 'refs';
      *$datum = sub { @_ > 1 ? ($_[0]->{$datum} = $_[1]) : $_[0]->{$datum}
      };
@@ -235,7 +238,7 @@
         $self->RawSocket($sock) unless $self->{Socket};
     }
 
-    !$self->{Socket} && $self->{Server} ?  $self->connect : $self;
+    !$self->{Socket} && $self->{Server} ? $self->connect : $self;
 }
 
 sub connect(@)
@@ -771,18 +774,23 @@
         }
 
         # Get the "+ Go ahead" response:
-        my $code = 0;
-        until($code eq '+' || $code =~ /NO|BAD|OK/)
+        my $code;
+        until(defined $code)
         {
              my $readSoFar  = 0;
-             my $fromBuffer = '';;
+             my $fromBuffer = '';
              $readSoFar += sysread($toSock, $fromBuffer, 1, $readSoFar) || 0
                  until $fromBuffer =~ /\r\n/;
 
-             $code = $fromBuffer =~ /^\+/ ? $1
-                   : $fromBuffer =~ / ^(?:\d+\s(BAD|NO))/ ? $1 : 0;
+             $code = $fromBuffer =~ /^\+/ ? 'OK'
+                   : $fromBuffer =~ /^(?:\d+\s(BAD|NO|OK))/ ? $1 : undef;
 
              $peer->_debug("$folder: received $fromBuffer from server");
+
+             if($fromBuffer =~ /^\*\s+BYE/i)
+             {   $self->State(Unconnected);
+                 return undef;
+             }
 
              # ... and log it in the history buffers
              $self->_record($trans, [0, "OUTPUT",
@@ -790,7 +798,7 @@
              $peer->_record($ptrans, [0, "OUTPUT", $fromBuffer] );
         }
 
-        if($code ne '+')
+        if($code ne 'OK')
         {   $self->_debug("Error writing to target host: $@");
             next MIGMSG;
         }
@@ -1075,12 +1083,10 @@
     @{$self->Results};  #??? enforce list context
 }
 
-# _{name} methods are undocumented and meant to be private.
-
-# _imap_command runs a command, inserting the correct tag
-# and <CR><LF> and whatnot.
-# When updating _imap_command, remember to examine the run method,
-# too, since it is very similar.
+
+# _imap_command runs a command, inserting the correct tag and <CR><LF> and whatnot.
+# When updating _imap_command, remember to examine the run() method too, since
+# it is very similar.
 
 sub _imap_command
 {   my $self   = shift;
@@ -1090,7 +1096,7 @@
 
     my $clear = $self->Clear;
     $self->Clear($clear)
-        if $self->Count >= $clear and $clear > 0;
+        if $self->Count >= $clear && $clear > 0;
 
     my $count  = $self->Count($self->Count+1);
     $string    = "$count $string";
@@ -1111,14 +1117,14 @@
         {   $self->_record($count, $o);
             $self->_is_output($o) or next;
 
-            if($good eq '+')
-            {   $o->[DATA] =~ /^$count\s+(OK|BAD|NO|$qgood)|^($qgood)/mi;
-                $code = $1||$2;
+            if($good eq '+' && $o->[DATA] =~ /^$qgood/m)
+            {   $code = $qgood;
             }
             else
             {   ($code) = $o->[DATA] =~ /^$count\s+(OK|BAD|NO|$qgood)/mi;
             }
-            if ($o->[DATA] =~ /^\*\s+BYE/im)
+
+            if($o->[DATA] =~ /^\*\s+BYE/im)
             {   $self->State(Unconnected);
                 return undef;
             }
@@ -1126,7 +1132,6 @@
     }
 
     $code =~ /^OK|$qgood/im ? $self : undef;
-
 }
 
 sub _imap_uid_command
@@ -1140,42 +1145,40 @@
 {   my $self   = shift;
     my $string = shift or return undef;
     my $good   = shift || 'GOOD';
+    my $qgood  = quotemeta $good;
+
     my $count  = $self->Count($self->Count+1);
     my $tag    = $string =~ /^(\S+) / ? $1 : undef;
 
     $tag or $self->LastError("Invalid string passed to run method; no tag found.");
 
-    my $qgood  = quotemeta($good);
     my $clear  = $self->Clear;
     $self->Clear($clear)
         if $self->Count >= $clear && $clear > 0;
 
     $self->_record($count, [$self->_next_index($count), "INPUT", $string] );
 
-    unless($self->_send_line("$string",1))
+    unless($self->_send_line($string, 1))
     {   $self->LastError("Error sending '$string' to IMAP: $!");
         return undef;
     }
 
-    my ($code, $output);
-    $output = "";
-
+    my $code = '';
     until($code =~ /(OK|BAD|NO|$qgood)/m )
-    {   $output = $self->_read_line or return undef;
+    {   my $output = $self->_read_line or return undef;
         foreach my $o (@$output)
-        {   $self->_record($count,$o);
+        {   $self->_record($count, $o);
             $self->_is_output($o) or next;
 
-            if($good eq '+')
-            {   $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)|(^$qgood)/m;
-                $code = $1 || $2;
+            if($good eq '+' && $o->[DATA] =~ /^$qgood/mi)
+            {   $code = $qgood;
             }
             else
-            {   ($code) = $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)/m;
-            }
-
-            $o->[DATA] =~ /^\*\s+BYE/
-                and $self->State(Unconnected);
+            {   ($code) = $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)/mi;
+            }
+
+            $self->State(Unconnected)
+                if $o->[DATA] =~ /^\*\s+BYE/;
         }
     }
 
@@ -1287,7 +1290,7 @@
 # It is also re-implemented in: message_to_file
 #
 # $output = $self->_read_line($literal_callback, $output_callback)
-#    Both input argument are optional, but if supplied must either
+#    Both input arguments are optional, but if supplied must either
 #    be a filehandle, coderef, or undef.
 #
 #    Returned argument is a reference to an array of arrays, ie:
@@ -1586,7 +1589,7 @@
         return undef;
     }
 
-    my @out = $self->fetch($msg,"BODYSTRUCTURE");
+    my @out = $self->fetch($msg, "BODYSTRUCTURE");
     my $bs = "";
     my $output = first { /BODYSTRUCTURE\s+\(/i } @out;    # Wee! ;-)
     if($output =~ /\r\n$/)
@@ -1615,13 +1618,13 @@
         eval { $bs = Mail::IMAPClient::BodyStructure->new( $output )};
     }
 
-    $self->_debug("get_bodystructure: msg $msg returns: ". $bs||"UNDEF");
+    $self->_debug("get_bodystructure: msg $msg returns: ". ($bs||"UNDEF"));
     $bs;
 }
 
 # Updated to handle embedded literal strings
 sub get_envelope
-{   my ($self,$msg) = @_;
+{   my ($self, $msg) = @_;
     unless( eval {require Mail::IMAPClient::BodyStructure ; 1 } )
     {   $self->LastError("Unable to use get_envelope: $@");
         return undef;
@@ -2328,7 +2331,7 @@
 
     my $clear  = $self->Clear;
     $self->Clear($clear)
-        if $self->Count >= $clear and $clear > 0;
+        if $self->Count >= $clear && $clear > 0;
 
     my $count  = $self->Count($self->Count+1);
     $text =~ s/\r?\n/\r\n/g;
@@ -2408,7 +2411,7 @@
 
     my $clear = $self->Clear;
     $self->Clear($clear)
-        if $self->Count >= $clear and $clear > 0;
+        if $self->Count >= $clear && $clear > 0;
 
     my $length = $bare_nl_count + -s $file;
     my $string = "$count APPEND $mfolder $fflags $date\{$length}\r\n";
@@ -2578,6 +2581,7 @@
            require Authen::NTLM;
            Authen::NTLM::ntlm_user($self->User);
            Authen::NTLM::ntlm_password($self->Password);
+           Authen::NTLM::ntlm_domain($self->Domain) if $self->Domain;
            Authen::NTLM::ntlm();
          };
     }

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=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Thu Jan 15 22:21:13 2009
@@ -140,7 +140,7 @@
 changed semantics to make it more "DWIM". The I<RawSocket> parameter was
 introduced as a replacement for the I<Socket> parameter in older version.
 
-=item State, Server, Proxy, Password, and User Parameters
+=item State, Server, Proxy, Password, User, Domain Parameters
 
 If you need to make your own connection to the server and perform your
 authentication manually, then you can set these parameters to keep your
@@ -148,7 +148,7 @@
 only the I<State> parameter is always necessary.  The others need to be
 set only if you think your program will need them later.
 
-I<Proxy> is required for PLAIN (SASL) authentication.
+I<Proxy> is required for PLAIN (SASL) authentication.  I<Domain> for NTLM.
 
 =item Authmechanism 
 
@@ -2175,9 +2175,9 @@
 
 	$imap->run(@args) or die "Could not run: $@\n";
 
-Like Perl itself, the B<Mail::IMAPClient> module is designed to make
-common things easy and uncommon things possible. The B<run> method is
-provided to make those uncommon things possible.
+The B<run> method is provided to make those uncommon things
+possible... however, we would like you to contribute the knowledge
+of missing features with us.
 
 The B<run> method excepts one or two arguments. The first argument is a
 string containing an IMAP Client command, including a tag and all

Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.grammar
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.grammar?rev=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.grammar (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Thu Jan 15 22:21:13 2009
@@ -34,7 +34,7 @@
 NIL:		/^NIL/i			{ $return = "NIL"    }
 NUMBER:		/^(\d+)/		{ $return = $item[1] }
 
-# 	Strings:
+# Strings:
 
 SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { $return = $item{__PATTERN1__} }
 DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { $return = $item{__PATTERN1__} }
@@ -128,11 +128,11 @@
 	  1;
 	}
 
-othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?)
+othertypemessage: bodytype basicfields bodyMD5(?) bodydisp(?)
 	          bodylang(?) bodyextra(?)
 	{ $return = { bodytype => $item{bodytype} };
 	  take_optional_items($return, \%item
-             , qw/bodyparms bodydisp bodylang bodyextra/ );
+             , qw/bodyMD5 bodydisp bodylang bodyextra/ );
 	  merge_hash($return, $item{basicfields});
 	  1;
 	}
@@ -148,7 +148,7 @@
 #             envelopestruct bodystructure textlines/;
 
 	  take_optional_items($return, \%item
-, qw/envelopestruct bodystructure textlines/
+            , qw/envelopestruct bodystructure textlines/
 	    , qw/bodyMD5 bodydisp bodylang bodyextra/);
 
 	  merge_hash($return, $item{bodystructure}[0]);

Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.pm?rev=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient/BodyStructure/Parse.pm Thu Jan 15 22:21:13 2009
@@ -5649,7 +5649,7 @@
 	while (!$_matched && !$commit)
 	{
 		
-		Parse::RecDescent::_trace(q{Trying production: [bodytype basicfields bodyparms bodydisp bodylang bodyextra]},
+		Parse::RecDescent::_trace(q{Trying production: [bodytype basicfields bodyMD5 bodydisp bodylang bodyextra]},
 					  Parse::RecDescent::_tracefirst($_[1]),
 					  q{othertypemessage},
 					  $tracelevel)
@@ -5722,30 +5722,30 @@
 		
 		}
 
-		Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]},
+		Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]},
 				  Parse::RecDescent::_tracefirst($text),
 				  q{othertypemessage},
 				  $tracelevel)
 					if defined $::RD_TRACE;
-		$expectation->is(q{bodyparms})->at($text);
-		
-		unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms, 0, 1, $_noactions,$expectation,undef))) 
-		{
-			Parse::RecDescent::_trace(q{<<Didn't match repeated subrule: [bodyparms]>>},
+		$expectation->is(q{bodyMD5})->at($text);
+		
+		unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) 
+		{
+			Parse::RecDescent::_trace(q{<<Didn't match repeated subrule: [bodyMD5]>>},
 						  Parse::RecDescent::_tracefirst($text),
 						  q{othertypemessage},
 						  $tracelevel)
 							if defined $::RD_TRACE;
 			last;
 		}
-		Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (}
+		Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (}
 					. @$_tok . q{ times)},
 					  
 					  Parse::RecDescent::_tracefirst($text),
 					  q{othertypemessage},
 					  $tracelevel)
 						if defined $::RD_TRACE;
-		$item{q{bodyparms(?)}} = $_tok;
+		$item{q{bodyMD5(?)}} = $_tok;
 		push @item, $_tok;
 		
 
@@ -5843,7 +5843,7 @@
 
 		$_tok = ($_noactions) ? 0 : do { $return = { bodytype => $item{bodytype} };
 	  take_optional_items($return, \%item
-             , qw/bodyparms bodydisp bodylang bodyextra/ );
+             , qw/bodyMD5 bodydisp bodylang bodyextra/ );
 	  merge_hash($return, $item{basicfields});
 	  1;
 	};
@@ -5862,7 +5862,7 @@
 		
 
 
-		Parse::RecDescent::_trace(q{>>Matched production: [bodytype basicfields bodyparms bodydisp bodylang bodyextra]<<},
+		Parse::RecDescent::_trace(q{>>Matched production: [bodytype basicfields bodyMD5 bodydisp bodylang bodyextra]<<},
 					  Parse::RecDescent::_tracefirst($text),
 					  q{othertypemessage},
 					  $tracelevel)
@@ -9512,7 +9512,7 @@
 #             envelopestruct bodystructure textlines/;
 
 	  take_optional_items($return, \%item
-, qw/envelopestruct bodystructure textlines/
+            , qw/envelopestruct bodystructure textlines/
 	    , qw/bodyMD5 bodydisp bodylang bodyextra/);
 
 	  merge_hash($return, $item{bodystructure}[0]);
@@ -14436,7 +14436,7 @@
                                                              'calls' => [
                                                                           'bodytype',
                                                                           'basicfields',
-                                                                          'bodyparms',
+                                                                          'bodyMD5',
                                                                           'bodydisp',
                                                                           'bodylang',
                                                                           'bodyextra'
@@ -14470,7 +14470,7 @@
                                                                                                          'line' => 131
                                                                                                        }, 'Parse::RecDescent::Subrule' ),
                                                                                                 bless( {
-                                                                                                         'subrule' => 'bodyparms',
+                                                                                                         'subrule' => 'bodyMD5',
                                                                                                          'expected' => undef,
                                                                                                          'min' => 0,
                                                                                                          'argcode' => undef,
@@ -14519,7 +14519,7 @@
                                                                                                          'line' => 133,
                                                                                                          'code' => '{ $return = { bodytype => $item{bodytype} };
 	  take_optional_items($return, \\%item
-             , qw/bodyparms bodydisp bodylang bodyextra/ );
+             , qw/bodyMD5 bodydisp bodylang bodyextra/ );
 	  merge_hash($return, $item{basicfields});
 	  1;
 	}'
@@ -15534,7 +15534,7 @@
 #             envelopestruct bodystructure textlines/;
 
 	  take_optional_items($return, \\%item
-, qw/envelopestruct bodystructure textlines/
+            , qw/envelopestruct bodystructure textlines/
 	    , qw/bodyMD5 bodydisp bodylang bodyextra/);
 
 	  merge_hash($return, $item{bodystructure}[0]);

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=29682&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t (original)
+++ branches/upstream/libmail-imapclient-perl/current/t/bodystructure.t Thu Jan 15 22:21:13 2009
@@ -4,7 +4,7 @@
 use strict;
 use lib 'lib';
 
-use Test::More tests => 10;
+use Test::More tests => 11;
 
 use Data::Dumper;
 $Data::Dumper::Indent=1;
@@ -51,3 +51,12 @@
 
 $bsobj = Mail::IMAPClient::BodyStructure->new($bs4);
 ok(defined $bsobj, 'parsed fourth');
+
+# 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))
+END_OF_BS5
+
+$bsobj = Mail::IMAPClient::BodyStructure->new($bs5);
+ok(defined $bsobj, 'parsed fifth');
+




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