How to clean-up HTTP::Async if still in use - perl

Question

I am using Perl library HTTP::Async as follows:
use strict;
use warnings;
use HTTP::Async;
use Time::HiRes;
...
my $async = HTTP::Async->new( ... );
my $request = HTTP::Request->new( GET => $url );
my $start = [Time::HiRes::gettimeofday()];
my $id = $async->add($request);
my $response = undef;
while (!$response) {
$response = $async->wait_for_next_response(1);
last if Time::HiRes::tv_interval($start) > TIME_OUT;
}
...
When while loop timeout and script ends, I experience the the following error message:
HTTP::Async object destroyed but still in use at script.pl line 0
HTTP::Async INTERNAL ERROR: 'id_opts' not empty at script.pl line 0
What are my options? How can I "clean-up" HTTP::Async object if still in use, but not needed anymore?

Answer 1

I would suggest that you remove incomplete requests, but the module does not provide any interface to do so.
Option 1: Add removal functionality.
Add the following to your script:
BEGIN {
require HTTP::Async;
package HTTP::Async;
if (!defined(&remove)) {
*remove = sub {
my ($self, $id) = #_;
my $hashref = $self->{in_progress}{$id}
or return undef;
my $s = $hashref->{handle};
$self->_io_select->remove($s);
delete $self->{fileno_to_id}{ $s->fileno };
delete $self->{in_progress}{$id};
delete $self->{id_opts}{$id};
return $hashref->{request};
};
}
if (!defined(&remove_all)) {
*remove_all = sub {
my ($self) = #_;
return map $self->remove($_), keys %{ $self->{in_progress} };
};
}
}
You should contact the author and see if he can add this feature. $id is the value returned by add.
Option 2: Silence all warnings from the destructor.
If you're ok with not servicing all the requests, there's no harm in silencing the warnings. You can do so as follows:
use Sub::ScopeFinalizer qw( scope_finalizer );
my $async = ...;
my $anchor = scope_finalizer {
local $SIG{__WARN__} = sub { };
$async = undef;
};
...
Note that this will silence all warnings that occur during the object's destruction, so I don't like this as much.

Answer 2

It's not too hard to subclass HTTP::Async for a more general solution. I use this to be able to abort all pending requests:
package HTTP::Async::WithFlush;
use strict;
use warnings;
use base 'HTTP::Async';
use Time::HiRes qw(time);
sub _flush_to_send {
my $self = shift;
for my $request (#{ $self->{to_send} }) {
delete $self->{id_opts}->{$request->[1]};
}
$self->{to_send} = [];
}
sub _flush_in_progress {
my $self = shift;
# cause all transfers to time out
for my $id (keys %{ $self->{in_progress} }) {
$self->{in_progress}->{$id}->{finish_by} = time - 1;
}
$self->_process_in_progress;
}
sub _flush_to_return {
my $self = shift;
while($self->_next_response(-1)) { }
}
sub flush_pending_requests {
my $self = shift;
$self->_flush_to_send;
$self->_flush_in_progress;
$self->_flush_to_return;
return;
}
1;
This is (maybe) easier on using the module internals than the code by #ikegami.