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

[alexmv at bestpractical.com]

Author: alexmv
Date: Fri Apr 11 15:25:24 2008
New Revision: 11692

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

Log:
 r29771 at kohr-ah:  chmrr | 2008-04-11 15:24:52 -0400
  * Weaken the timeout callback, so we don't leak connection objects
  * Don't double-store refs to connections
  * Actually clean out old keys in the connection hash


Modified: Net-IMAP-Server/lib/Net/IMAP/Server.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server.pm	Fri Apr 11 15:25:24 2008
@@ -55,7 +55,7 @@
 =cut
 
 __PACKAGE__->mk_accessors(
-    qw/connections port ssl_port auth_class model_class connection_class user group poll_every unauth_idle auth_idle unauth_commands/
+    qw/port ssl_port auth_class model_class connection_class user group poll_every unauth_idle auth_idle unauth_commands/
 );
 
 =head2 new PARAMHASH
@@ -149,7 +149,7 @@
             auth_idle        => 60*60,
             unauth_commands  => 10,
             @_,
-            connections => [],
+            connection       => {},
         }
     );
     UNIVERSAL::require( $self->auth_class )
@@ -214,7 +214,7 @@
         io_handle => $handle,
         server    => $self,
     );
-    push @{ $self->connections }, $conn;
+    $self->connection($conn);
     $conn->handle_lines;
 }
 
@@ -238,6 +238,11 @@
 
 =cut
 
+sub connections {
+    my $self = shift;
+    return [ values %{$self->{connection}} ];
+}
+
 =head2 connection
 
 Returns the currently active L<Net::IMAP::Server::Connection> object,
@@ -249,7 +254,11 @@
 sub connection {
     my $self = shift;
     if (@_) {
-        $self->{connection}{$Coro::current . ""} = shift;
+        if (defined $_[0]) {
+            $self->{connection}{$Coro::current . ""} = shift;
+        } else {
+            delete $self->{connection}{$Coro::current . ""};
+        }
     }
     return $self->{connection}{$Coro::current . ""};
 }

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	Fri Apr 11 15:25:24 2008
@@ -6,6 +6,7 @@
 use base 'Class::Accessor';
 
 use Coro;
+use Scalar::Util qw/weaken/;
 
 use Net::IMAP::Server::Command;
 
@@ -127,7 +128,6 @@
 sub handle_lines {
     my $self = shift;
     $self->coro->prio(-4);
-    $self->server->connection($self);
 
     eval {
         $self->greeting;
@@ -167,9 +167,11 @@
     my $self = shift;
     $self->timer->stop if $self->timer;
     $self->timer(undef);
+    my $weakself = $self;
+    weaken($weakself);
     my $timeout = sub {
-        $self->coro->throw("Timeout\n");
-        $self->coro->ready;
+        $weakself->coro->throw("Timeout\n");
+        $weakself->coro->ready;
     };
     if ( $self->is_unauth and $self->server->unauth_idle ) {
         $self->timer( EV::timer $self->server->unauth_idle, 0, $timeout );
@@ -243,8 +245,6 @@
 
 sub close {
     my $self = shift;
-    $self->server->connections(
-        [ grep { $_ ne $self } @{ $self->server->connections } ] );
     if ( $self->io_handle ) {
         $self->io_handle->close;
         $self->io_handle(undef);
@@ -253,6 +253,7 @@
     $self->selected->close if $self->selected;
     $self->model->close    if $self->model;
     $self->server->connection(undef);
+    $self->coro(undef);
 }
 
 =head2 parse_command LINE