Added remove($id) and remove_all() methods

This was requested by Ikegami in
https://rt.cpan.org/Ticket/Display.html?id=77200

The logic is slightly complicated as it needs to remove the items from
one of three state queues: "to_send", "in_progress" or "to_return".

The tests for this are quite complicated as we needed to be certain of
having items in specific states such as "to_return" and "in_progress".

lib/HTTP/Async.pm

@@ -419,6 +419,65 @@ sub info {
     );
 }
 
+=head2 remove
+
+    $async->remove($id);
+    my $success = $async->remove($id);
+
+Removes the item with the given id no matter which state it is currently in. Returns true if an item is removed, and false otherwise.
+
+=cut
+
+sub remove {
+    my $self = shift;
+    my $id = shift;
+
+    my $hashref = delete $self->{in_progress}{$id};
+    if (!$hashref) {
+        for my $list ('to_send', 'to_return') {
+            my ($r_and_id) = grep { $_->[1] eq $id } @{ $self->{$list} };
+            $hashref = $r_and_id->[0];
+            if ($hashref) {
+                @{ $self->{$list} }
+                    = grep { $_->[1] ne $id } @{ $self->{$list} };
+            }
+        }
+    }
+    return if !$hashref;
+
+    my $s = $hashref->{handle};
+    $self->_io_select->remove($s);
+    delete $self->{id_opts}{$id};
+
+    return 1;
+}
+
+=head2 remove_all
+
+    $async->remove_all;
+    my $success = $async->remove_all;
+
+Removes all items no matter what states they are currently in. Returns true if any items are removed, and false otherwise.
+
+=cut
+
+sub remove_all {
+    my $self = shift;
+    return if $self->empty;
+
+    my @ids = (
+        (map { $_->[1] } @{ $self->{to_send} }),
+        (keys %{ $self->{in_progress} }),
+        (map { $_->[1] } @{ $self->{to_return} }),
+    );
+
+    for my $id (@ids) {
+        $self->remove($id);
+    }
+
+    return 1;
+}
+
 =head2 empty, not_empty
 
     while ( $async->not_empty ) { ...; }

t/remove.t

@@ -0,0 +1,104 @@
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+
+use HTTP::Request;
+use HTTP::Async;
+
+## Set up - create an Async object with ten items in its queue
+
+require 't/TestServer.pm';
+# To ensure that remove and remove_all work on all three states, we need to
+# have items in all three states when we call them.
+#
+# The three states are: to_send, in_progress, and to_return.
+#
+# We can create them by adding items which will run quickly, items which will
+# trickle data slowly, and items which are not running.
+#
+# XXX we currently only test in_progress and to_return as items are hard to
+# keep in the to_send queue, HTTP::Async is too good at moving them into the
+# to_progress queue!
+{
+    my $s        = TestServer->new(84000);
+    my $url_root = $s->started_ok("starting a test server");
+
+    my $q = HTTP::Async->new;
+
+    is $q->total_count, 0, "total_count starts at zero";
+
+    my %type_to_id = populate_queues($q, $url_root);
+
+    ## Remove - test remove() to remove a single item
+
+    for my $type (sort keys %type_to_id) {
+        my $id = $type_to_id{$type};
+        ok $q->remove($id), "removed '$type' item with id '$id'";
+    }
+
+    ok !$q->remove(123456), "removal of bad id '123456' returns false";
+
+    is $q->total_count, 0, "total_count is now zero";
+}
+
+{
+    my $s        = TestServer->new(84001);
+    my $url_root = $s->started_ok("starting a test server");
+
+    my $q = HTTP::Async->new;
+
+    is $q->total_count, 0, "total_count starts at zero";
+
+    my %type_to_id = populate_queues($q, $url_root);
+
+    ## Remove All - test remove_all() removes all queued items
+
+    ok $q->remove_all, "removed all items";
+
+    ok !$q->remove_all, "remove_all() on empty queue returns false";
+
+    is $q->total_count, 0, "total_count is now zero";
+}
+
+##############################################################################
+
+sub populate_queues {
+    my $q = shift;
+    my $url_root = shift;
+
+    my %type_to_id;
+
+    # fast / to_return
+    {
+        my $url = "$url_root?trickle=1";
+        my $req = HTTP::Request->new('GET', $url);
+        ok $type_to_id{'fast'} = $q->add($req), "added fast / to_return item";
+
+        for (1 .. 10) {
+            $q->poke;
+            last if $q->to_return_count;
+            sleep 1;
+        }
+
+        if (!$q->to_return_count) {
+            use Data::Dumper;
+            warn Dumper $q;
+        }
+
+        is $q->to_return_count, 1, "to_return_count is one";
+    }
+
+    # slow / in_progress
+    {
+        my $url = "$url_root?trickle=1000";
+        my $req = HTTP::Request->new('GET', $url);
+        ok $type_to_id{'slow'} = $q->add($req), "added slow / in_progress item";
+        $q->poke;
+        is $q->in_progress_count, 1, "in_progress_count is one";
+    }
+
+    is $q->total_count, 2, "total_count is now two";
+
+    return %type_to_id;
+}