File Coverage

blib/lib/Test/WWW/Stub/Intercepter.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	3	4	75.0
condition	2	2	100.0
subroutine	9	9	100.0
pod	0	4	0.0
total	50	55	90.9

package Test::WWW::Stub::Intercepter;

use strict;
use warnings;
use List::MoreUtils ();

use Test::WWW::Stub::Handler;

sub new {
    my ($class) = @_;
    return bless { registry => {} }, $class;
}

sub intercept {
    my ($self, $uri, $env, $req) = @_;
    for my $pattern (sort { length $a <=> length $b } keys %{ $self->{registry} }) {
        for my $handler (@{$self->{registry}->{$pattern}}) {
            my $maybe_res = $handler->try_call($uri, $env, $req);
            return $maybe_res if $maybe_res;
        }
    }
    return undef;
}

sub register {
    my ($self, $uri_or_re, $app_or_res) = @_;
    my $handler = Test::WWW::Stub::Handler->factory($uri_or_re, $app_or_res);
    $self->{registry}->{$uri_or_re} //= [];
    unshift @{$self->{registry}->{$uri_or_re}}, $handler;
    return $handler;
}

sub unregister {
    my ($self, $uri_or_re, $handler) = @_;
    return unless exists $self->{registry}->{$uri_or_re};

    my $idx = List::MoreUtils::firstidx { $_ eq $handler } @{$self->{registry}->{$uri_or_re}};
    splice @{$self->{registry}->{$uri_or_re}}, $idx, 1;
}

1;