Skip Menu |

This queue is for tickets about the Net-Async-HTTP CPAN distribution.

Report information
The Basics
Id: 79295
Status: resolved
Priority: 0/
Queue: Net-Async-HTTP

People
Owner: Nobody in particular
Requestors: tag [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.17
Fixed in: 0.18



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>
Applied, sortof. With some modifications, and reworking of the connection close logic. See -r177. -- Paul Evans
This was released in 0.18. -- Paul Evans