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

alexmv at bestpractical.com alexmv at bestpractical.com
Fri Oct 19 20:38:28 EDT 2007


Author: alexmv
Date: Fri Oct 19 20:37:52 2007
New Revision: 9375

Modified:
   Net-Server-IMAP/   (props changed)
   Net-Server-IMAP/lib/Net/Server/IMAP.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm

Log:
 r23762 at zoq-fot-pik:  chmrr | 2007-10-19 20:36:41 -0400
  * Split data loading and initialization of mailboxes
  * Partial expunge
  * Server ->auth call


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	Fri Oct 19 20:37:52 2007
@@ -74,6 +74,7 @@
                     # Process socket
                     local $Net::Server::IMAP::Server = $self;
                     local $self->{connection} = $self->connections->{ $fh->fileno };
+                    local $self->{auth}       = $self->connections->{ $fh->fileno }->auth;
                     $self->connections->{ $fh->fileno }->handle_command;
                 }
             }
@@ -92,6 +93,11 @@
     return $self->{connection};
 }
 
+sub auth {
+    my $self = shift;
+    return $self->{auth};
+}
+
 sub concurrent_connections {
     my $class = shift;
     my $self = ref $class ? $class : $Net::Server::IMAP::Server;

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm	Fri Oct 19 20:37:52 2007
@@ -14,6 +14,7 @@
     my $class = shift;
     my $self  = $class->SUPER::new(@_);
     $self->init;
+    $self->load_data;
     return $self;
 }
 
@@ -26,7 +27,10 @@
     $self->children( [] );
     $self->uidvalidity( scalar time );
     $self->subscribed( 1 );
+}
 
+sub load_data {
+    my $self = shift;
     my $name = $self->full_path;
     return unless $name;
     $name =~ s/\W+/_/g;
@@ -181,11 +185,14 @@
 
 sub expunge {
     my $self = shift;
+    my $only = shift;
+    return if $only and not @{$only};
+    my %only; $only{$_}++ for @{$only || []};
 
     my @ids;
     my $offset   = 0;
     my @messages = @{ $self->messages };
-    $self->messages( [ grep { not $_->has_flag('\Deleted') } @messages ] );
+    $self->messages( [ grep { not ( $_->has_flag('\Deleted') and (not $only or $only{$_->sequence}))} @messages ] );
     for my $c (Net::Server::IMAP->concurrent_connections($self)) {
         # Ensure that all other connections with this selected get a
         # temporary message list, if they don't already have one
@@ -198,7 +205,7 @@
     }
 
     for my $m (@messages) {
-        if ( $m->has_flag('\Deleted') ) {
+        if ( $m->has_flag('\Deleted') and (not $only or $only{$m->sequence})) {
             push @ids, $m->sequence - $offset;
             delete $self->uids->{$m->uid};
             $offset++;



More information about the Bps-public-commit mailing list