Subject: | Fix leaks (callback and memory leaks). |
------------------------------------------------------------
revno: 165
committer: Scott S. McCoy <tag@cpan.org>
branch nick: test
timestamp: Wed 2012-08-29 16:48:54 -0700
message:
Do not leak Net::Async::HTTP::Protocol objects or callbacks
* The ``on_closed'' handler deleted the local reference to the
connection in
NaHTTP but did not remove the Proto object as a child of the NaHTTP
object.
This has been corrected.
* ȯn_closed emits errors for all callbacks in the on_ready_queue.
Subject: | 165.patch |
=== modified file 'lib/Net/Async/HTTP.pm'
--- lib/Net/Async/HTTP.pm 2012-08-29 00:04:11 +0000
+++ lib/Net/Async/HTTP.pm 2012-08-29 23:48:54 +0000
@@ -13,7 +13,7 @@
our $DEFAULT_UA = "Perl + " . __PACKAGE__ . "/$VERSION";
our $DEFAULT_MAXREDIR = 3;
-our $DEFAULT_MAX_OUTSTANDING = 0;
+our $DEFAULT_MAX_OUTSTANDING = 4;
use Carp;
@@ -159,10 +159,10 @@
$self->SUPER::configure( %params );
- defined $self->{user_agent} or $self->{user_agent} = $DEFAULT_UA;
- defined $self->{max_redirects} or $self->{max_redirects} = $DEFAULT_MAXREDIR;
+ defined $self->{user_agent} or $self->{user_agent} = $DEFAULT_UA;
+ defined $self->{max_redirects} or $self->{max_redirects} = $DEFAULT_MAXREDIR;
defined $self->{max_outstanding} or $self->{max_outstanding} = $DEFAULT_MAX_OUTSTANDING;
- defined $self->{pipeline} or $self->{pipeline} = 1;
+ defined $self->{pipeline} or $self->{pipeline} = 1;
}
=head1 METHODS
@@ -194,10 +194,15 @@
notifier_name => $key,
max_outstanding => $self->{max_outstanding},
pipeline => $self->{pipeline},
- on_closed => sub {
+ on_closed => $self->_capture_weakself(sub {
+ my ($self, $conn) = @_;
+
+ $self->remove_child($conn);
+
delete $connections->{$key};
- },
+ }),
);
+
$self->add_child( $conn );
$connections->{$key} = $conn;
=== modified file 'lib/Net/Async/HTTP/Protocol.pm'
--- lib/Net/Async/HTTP/Protocol.pm 2012-08-29 00:04:11 +0000
+++ lib/Net/Async/HTTP/Protocol.pm 2012-08-29 23:48:54 +0000
@@ -72,6 +72,9 @@
sub connect
{
my $self = shift;
+
+ $self->debug_printf( "CONNECT" );
+
$self->SUPER::connect(
@_,
@@ -92,8 +95,13 @@
}
elsif( @$queue and $self->is_idle ) {
$self->debug_printf( "READY non-pipelined" );
+
( shift @$queue )->[ON_READY]->( $self );
}
+ else {
+ $self->debug_printf( "READY cannot-run (queue: %d, idle: %s)",
+ scalar @$queue, $self->is_idle ? "Y" : "N");
+ }
}
sub is_idle
@@ -106,6 +114,7 @@
{
my $self = shift;
$self->{outstanding_requests}--;
+ $self->debug_printf( "DONE $self->{outstanding_requests}" );
$self->ready;
}
@@ -114,9 +123,12 @@
my $self = shift;
my ( $on_ready, $on_error ) = @_;
+ $self->debug_printf( "ENQUEUE" );
+
push @{ $self->{on_ready_queue} }, [ $on_ready, $on_error ];
if( $self->transport ) {
+ # ready might be better renamed to ``try_ready'' or something.
$self->ready;
}
}
@@ -147,6 +159,14 @@
croak "Spurious on_read of connection while idle\n";
}
+sub error_on_ready {
+ my $self = shift;
+
+ while( my $head = shift @{ $self->{on_ready_queue} } ) {
+ $head->[ON_ERROR]->( @_ );
+ }
+}
+
sub error_all
{
my $self = shift;
@@ -155,9 +175,7 @@
$head->[ON_ERROR]->( @_ );
}
- while( my $head = shift @{ $self->{on_ready_queue} } ) {
- $head->[ON_ERROR]->( @_ );
- }
+ $self->error_on_ready;
}
sub request
@@ -165,9 +183,11 @@
my $self = shift;
my %args = @_;
+ $self->debug_printf( "REQUEST" );
+
my $on_header = $args{on_header} or croak "Expected 'on_header' as a CODE ref";
my $on_error = $args{on_error} or croak "Expected 'on_error' as a CODE ref";
-
+
my $req = $args{request};
ref $req and $req->isa( "HTTP::Request" ) or croak "Expected 'request' as a HTTP::Request reference";
@@ -313,6 +333,7 @@
if( $content_length == 0 ) {
$self->debug_printf( "BODY done" );
$on_body_chunk->();
+ $self->_request_done;
return undef; # Finished
}
@@ -393,9 +414,21 @@
$self->{outstanding_requests}++;
+ $self->debug_printf( "WAITING $self->{outstanding_requests}" );
+
push @{ $self->{responder_queue} }, [ $on_read, $on_error ];
}
+sub close {
+ my $self = shift;
+
+ $self->SUPER::close(@_);
+
+ # Drop the on-ready handlers, because they may cause a circular reference or
+ # otherwise just go stale.
+ $self->error_on_ready( "Connection lost" );
+}
+
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>