[Bps-public-commit] r9682 - in Net-Server-IMAP: . lib/Net/Server/IMAP
alexmv at bestpractical.com
alexmv at bestpractical.com
Thu Nov 15 20:20:52 EST 2007
Author: alexmv
Date: Thu Nov 15 20:20:48 2007
New Revision: 9682
Modified:
Net-Server-IMAP/ (props changed)
Net-Server-IMAP/lib/Net/Server/IMAP.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
Log:
r24855 at zoq-fot-pik: chmrr | 2007-11-15 20:19:27 -0500
* concurrent_connections -> concurrent_mailbox_connections
* Close the model when we disconnect
* Add prep_for_destroy methods to tear down circular references
* Merge the two main while loops of the server, to allow for clean
exit
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 Thu Nov 15 20:20:48 2007
@@ -59,23 +59,21 @@
$self->select->add($ssl);
}
- while ( $self->select ) {
- while ( my @ready = $self->select->can_read ) {
- Module::Refresh->refresh;
- foreach my $fh (@ready) {
- if ( $fh == $lsn or (defined $ssl and $fh == $ssl)) {
-
- # Create a new socket
- my $new = $fh->accept;
- # Accept can fail; if so, ignore the connection
- $self->accept_connection($new) if $new;
- } else {
-
- # Process socket
- local $Net::Server::IMAP::Server = $self;
- local $SIG{PIPE} = sub { warn "Broken pipe\n"; $self->connections->{ $fh->fileno}->close };
- $self->connections->{ $fh->fileno }->handle_lines;
- }
+ while ( $self->select and my @ready = $self->select->can_read ) {
+ Module::Refresh->refresh;
+ foreach my $fh (@ready) {
+ if ( $fh == $lsn or (defined $ssl and $fh == $ssl)) {
+
+ # Create a new socket
+ my $new = $fh->accept;
+ # Accept can fail; if so, ignore the connection
+ $self->accept_connection($new) if $new;
+ } else {
+
+ # Process socket
+ local $Net::Server::IMAP::Server = $self;
+ local $SIG{PIPE} = sub { warn "Broken pipe\n"; $self->connections->{ $fh->fileno}->close };
+ $self->connections->{ $fh->fileno }->handle_lines;
}
}
}
@@ -102,7 +100,7 @@
return $self->{model};
}
-sub concurrent_connections {
+sub concurrent_mailbox_connections {
my $class = shift;
my $self = ref $class ? $class : $Net::Server::IMAP::Server;
my $selected = shift || $self->connection->selected;
@@ -112,6 +110,16 @@
and $_->selected eq $selected} values %{$self->connections};
}
+sub concurrent_user_connections {
+ my $class = shift;
+ my $self = ref $class ? $class : $Net::Server::IMAP::Server;
+ my $user = shift || $self->connection->auth->user;
+
+ return () unless $self->connection->is_auth;
+ return grep {$_->is_auth
+ and $_->auth->user eq $user} values %{$self->connections};
+}
+
sub accept_connection {
my $self = shift;
my $handle = shift;
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 Thu Nov 15 20:20:48 2007
@@ -81,6 +81,7 @@
delete $self->server->connections->{ $self->io_handle->fileno };
$self->server->select->remove( $self->io_handle );
$self->io_handle->close;
+ $self->model->close if $self->model;
}
sub parse_command {
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm Thu Nov 15 20:20:48 2007
@@ -31,6 +31,9 @@
return $self;
}
+sub close {
+}
+
sub split {
my $self = shift;
return grep {length} split quotemeta $self->root->seperator, shift;
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 Thu Nov 15 20:20:48 2007
@@ -77,7 +77,7 @@
# Also need to add it to anyone that has this folder as a
# temporary message store
- for my $c (Net::Server::IMAP->concurrent_connections($self)) {
+ for my $c (Net::Server::IMAP->concurrent_mailbox_connections($self)) {
next unless $c->temporary_messages;
push @{$c->temporary_messages}, $message;
@@ -201,7 +201,7 @@
my $offset = 0;
my @messages = @{ $self->messages };
$self->messages( [ grep { not ( $_->has_flag('\Deleted') and (not $only or $only{$_->sequence}))} @messages ] );
- for my $c (Net::Server::IMAP->concurrent_connections($self)) {
+ for my $c (Net::Server::IMAP->concurrent_mailbox_connections($self)) {
# Ensure that all other connections with this selected get a
# temporary message list, if they don't already have one
unless (($Net::Server::IMAP::Server->connection and $c eq $Net::Server::IMAP::Server->connection)
@@ -239,6 +239,17 @@
sub poll {}
+sub prep_for_destroy {
+ my $self = shift;
+ my @kids = @{$self->children || []};
+ $self->children(undef);
+ $_->prep_for_destroy for @kids;
+ my @messages = @{$self->messages};
+ $self->messages(undef) if @messages;
+ $_->prep_for_destroy for @messages;
+ $self->parent(undef);
+}
+
package Email::IMAPFolder;
use base 'Email::Folder';
use YAML;
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 Thu Nov 15 20:20:48 2007
@@ -62,7 +62,7 @@
my $changed = not $old;
if ($changed and not @_) {
- for my $c (Net::Server::IMAP->concurrent_connections($self->mailbox)) {
+ for my $c (Net::Server::IMAP->concurrent_mailbox_connections($self->mailbox)) {
$c->untagged_fetch->{$c->sequence($self)}{FLAGS}++ unless $c->ignore_flags;
}
}
@@ -79,7 +79,7 @@
my $changed = $old;
if ($changed and not @_) {
- for my $c (Net::Server::IMAP->concurrent_connections($self->mailbox)) {
+ for my $c (Net::Server::IMAP->concurrent_mailbox_connections($self->mailbox)) {
$c->untagged_fetch->{$c->sequence($self)}{FLAGS}++ unless $c->ignore_flags;
}
}
@@ -339,4 +339,9 @@
}
}
+sub prep_for_destroy {
+ my $self = shift;
+ $self->mailbox(undef);
+}
+
1;
More information about the Bps-public-commit
mailing list