[Bps-public-commit] r9699 - in Net-Server-IMAP: . lib/Net/Server/IMAP lib/Net/Server/IMAP/Command

[alexmv at bestpractical.com]

Author: alexmv
Date: Mon Nov 19 17:31:51 2007
New Revision: 9699

Modified:
   Net-Server-IMAP/   (props changed)
   Net-Server-IMAP/lib/Net/Server/IMAP.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm

Log:
 r24899 at zoq-fot-pik:  chmrr | 2007-11-19 17:31:14 -0500
  * Abort FETCH and UID FETCH if the connection drops partway through
  * Allow mime body to be lazily generated, as much as possible


Modified: Net-Server-IMAP/lib/Net/Server/IMAP.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP.pm	Mon Nov 19 17:31:51 2007
@@ -115,7 +115,7 @@
     my $self = ref $class ? $class : $Net::Server::IMAP::Server;
     my $user = shift || $self->connection->auth->user;
 
-    return () unless $self->connection->is_auth;
+    return () unless $user;
     return grep {$_->is_auth
                  and $_->auth->user eq $user} values %{$self->connections};
 }

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm	Mon Nov 19 17:31:51 2007
@@ -25,6 +25,7 @@
     my ( $messages, $spec ) = $self->parsed_options;
     my @messages = $self->connection->get_messages($messages);
     for my $m (@messages) {
+        return unless $self->connection->connected;
         $self->untagged_response( $self->connection->sequence($m)
                 . " FETCH "
                 . $self->data_out( [ $m->fetch($spec) ] ) );

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm	Mon Nov 19 17:31:51 2007
@@ -46,6 +46,7 @@
     push @{$spec}, "UID" unless grep {uc $_ eq "UID"} @{$spec};
     my @messages = $self->connection->selected->get_uids($messages);
     for my $m (@messages) {
+        return unless $self->connection->connected;
         $self->untagged_response( $self->connection->sequence($m)
                 . " FETCH "
                 . $self->data_out( [ $m->fetch($spec) ] ) );

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm	Mon Nov 19 17:31:51 2007
@@ -243,6 +243,11 @@
     warn $msg . "\n";
 }
 
+sub connected {
+    my $self = shift;
+    return $self->io_handle and $self->io_handle->peerport;
+}
+
 sub out {
     my $self = shift;
     my $msg  = shift;

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm	Mon Nov 19 17:31:51 2007
@@ -36,6 +36,11 @@
     return 1;
 }
 
+sub mime_header {
+    my $self = shift;
+    return $self->mime->header_obj;
+}
+
 sub copy {
     my $self = shift;
     my $mailbox = shift;
@@ -146,8 +151,7 @@
         } elsif ( uc $part eq "FLAGS" ) {
             push @out, [ map { \$_ } $self->flags ];
         } elsif ( uc $part eq "RFC822.SIZE" ) {
-            my $result = $self->mime_select( [], undef, undef );
-            push @out, length $result;
+            push @out, length $self->mime_select( [], undef, undef );
         } elsif ( uc $part eq "BODY" ) {
             push @out, $self->mime_bodystructure( $self->mime, 0 );
         } elsif ( uc $part eq "BODYSTRUCTURE" ) {
@@ -165,24 +169,28 @@
     my $self = shift;
     my ( $sections, $start, $end, $extras ) = @_;
 
-    my $mime = $self->mime;
+    my $mime;
 
     my @sections = @{$sections};
-    my $result   = $self->mime->as_string;
+    my $result;
+    $result = $self->mime->as_string unless @sections;
     for (@sections) {
         if ( uc $_ eq "HEADER" or uc $_ eq "MIME" ) {
-            $result = $mime->header_obj->as_string . "\r\n";
+            $result = ($mime ? $mime->header_obj : $self->mime_header)->as_string . "\r\n";
         } elsif ( uc $_ eq "FIELDS" ) {
             my %case;
-            $case{ uc $_ } = $_ for $mime->header_names;
-            my $header = Email::Simple::Header->new("");
+            my $mime_header = $mime ? $mime->header_obj : $self->mime_header;
+            $case{ uc $_ } = $_ for $mime_header->header_names;
+            my $copy = Email::Simple::Header->new("");
             for my $h ( @{$extras} ) {
-                $header->header_set( $case{$h} || $h => $mime->header($h) );
+                $copy->header_set( $case{$h} || $h => $mime_header->header($h) );
             }
-            $result = $header->as_string ? $header->as_string . "\r\n" : "";
+            $result = $copy->as_string ? $copy->as_string . "\r\n" : "";
         } elsif ( uc $_ eq "TEXT" ) {
+            $mime ||= $self->mime;
             $result = $mime->body;
         } elsif ( $_ =~ /^\d+$/i ) {
+            $mime ||= $self->mime;
             my @parts = $mime->parts;
             $mime   = $parts[ $_ - 1 ];
             $result = $mime->body;
@@ -287,7 +295,7 @@
 sub address_envelope {
     my $self   = shift;
     my $header = shift;
-    my $mime   = $self->mime;
+    my $mime   = $self->mime_header;
 
     return undef unless $mime->header($header);
     return [ map { [ {type => "string", value => $_->name},
@@ -300,7 +308,7 @@
 
 sub mime_envelope {
     my $self = shift;
-    my $mime = $self->mime;
+    my $mime = $self->mime_header;
 
     return [
         scalar $mime->header("Date"),