File Coverage

blib/lib/MojoX/UserAgent/Throttler.pm

Criterion	Covered	Total	%
statement	49	50	98.0
branch	12	16	75.0
condition	7	11	63.6
subroutine	9	9	100.0
pod			n/a
total	77	86	89.5

package MojoX::UserAgent::Throttler;

use Mojo::Base -strict;

our $VERSION = 'v1.0.2';

use Mojo::UserAgent;
use Mojo::Util qw( monkey_patch );
use Sub::Util 1.40 qw( set_subname );
use Sub::Throttler 0.002000 qw( throttle_me throttle_me_sync done_cb );


# https://github.com/kraih/mojo/issues/663
# Inconsistent behavior of Mojo::UserAgent::DESTROY:
# - sync requests always executed, even when started while DESTROY
# - for all active async requests which was started before DESTROY user's
#   callback will be called with error in $tx
# - for all async requests which was started while DESTROY user's callback
#   won't be called
# To emulate this behaviour with throttling:
# - sync request: always executed, even when started while DESTROY
# - new async request while DESTROY: ignored
# - delayed async request (it was delayed before DESTROY):
#   * if it start before DESTROY: let Mojo::UserAgent handle it using
#     done_cb($done,$cb)
#   * if it start while DESTROY: do $done->(0) and call user's callback
#     with error in $tx
#   * if it still delayed after DESTROY: call user's callback with error
#     in $tx

use constant START_ARGS => 3;

my %Delayed;        # $ua => { $tx => [$tx, $cb], … }
my %IsDestroying;   # $ua => 1

my $ORIG_start  = \&Mojo::UserAgent::start;
my $ORIG_DESTROY= \&Mojo::UserAgent::DESTROY;

monkey_patch 'Mojo::UserAgent',
start => set_subname('Mojo::UserAgent::start', sub {
    # WARNING Async call return undef instead of (undocumented) connection $id.
    ## no critic (ProhibitExplicitReturnUndef)
    my ($self, $tx, $cb) = @_;
    if (START_ARGS == @_ && $cb) {
        if ($IsDestroying{ $self }) {
#             $cb->($self, $tx->client_close(1)); # to fix issue 663 or not to fix?
            return undef;
        }
        else {
            $Delayed{ $self }{ $tx } = [ $tx, $cb ];
        }
    }
    my $done = ref $_[-1] eq 'CODE' ? &throttle_me || return undef : &throttle_me_sync;
    ($self, $tx, $cb) = @_;
    if ($cb) {
        if ($IsDestroying{ $self }) {
            $done->(0);
        }
        else {
            delete $Delayed{ $self }{ $tx };
            $self->$ORIG_start($tx, done_cb($done, $cb));
        }
        return undef;
    }
    else {
        $tx = $self->$ORIG_start($tx);
        $done->();
        return $tx;
    }
}),
DESTROY => sub {
    my ($self) = @_;
    $IsDestroying{ $self } = 1;
    for (values %{ delete $Delayed{ $self } || {} }) {
        my ($tx, $cb) = @{ $_ };
        $cb->($self, _client_close($tx, 1));
    }
    $self->$ORIG_DESTROY;
    delete $IsDestroying{ $self };
    return;
};

# This is a replacement of $tx->client_close() removed in Mojolicious 6.43.
sub _client_close {
    ## no critic(ProhibitAmbiguousNames,ProhibitMagicNumbers)
    my ($self, $close) = @_;

    my $res = $self->completed->emit('finish')->res->finish;
    if ($close && !$res->code && !$res->error) {
        $res->error({message => 'Premature connection close'});
    }
    elsif ($res->is_error) {
        $res->error({message => $res->message, code => $res->code});
    }

    return $self;
}


1; # Magic true value required at end of module
__END__