File Coverage

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

Criterion	Covered	Total	%
statement	45	46	97.8
branch	13	14	92.8
condition	2	3	66.6
subroutine	13	13	100.0
pod	0	4	0.0
total	73	80	91.2

package Test::WWW::Stub::Handler;

use strict;
use warnings;

use Carp qw(confess);
use Scalar::Util qw(blessed);

sub new {
    my ($class, %args) = @_;
    my $pattern = $args{pattern};
    my $app     = $args{app};
    return bless { pattern => $pattern, app => $app }, $class;
}

sub factory {
    my ($class, $uri_or_re, $app_or_res) = @_;
    if (blessed($app_or_res) && $app_or_res->isa('Test::WWW::Stub::Handler')) {
        return $app_or_res;
    }
    my $app;
    my $type = ref($app_or_res);
    if ($type eq 'CODE') {
        $app = $app_or_res;
    } elsif ($type eq 'ARRAY') {
        $app = sub { $app_or_res };
    } else {
        confess 'Handler MUST be a PSGI app or an ARRAY';
    }
    return $class->new(pattern => $uri_or_re, app => $app);
}

sub is_static_pattern {
    my ($self) = @_;
    return ref($self->{pattern}) ne 'Regexp';
}

sub try_call {
    my ($self, $uri, $env, $req) = @_;
    my ($matched, $captures) = $self->_match($uri);
    return undef unless $matched;
    return $self->_call($env, $req, @$captures);
}

sub _call {
    my ($self, $env, $req, @match) = @_;
    $env->{'test.www.stub.handler'} = [ $self->{pattern}, $self->{app} ];
    return $self->{app}->($env, $req, @match);
}

sub _match {
    my ($self, $uri) = @_;
    return $self->is_static_pattern ? $self->_match_static($uri) : $self->_match_regexp($uri);
}

sub _match_static {
    my ($self, $uri) = @_;
    my $matched = $uri eq $self->{pattern} ? 1 : 0;
    return ($matched, []);
}

sub _match_regexp {
    my ($self, $uri) = @_;
    my $pattern = $self->{pattern};
    my @captures = $uri =~ m/$pattern/;
    my $matched = @captures > 0 ? 1 : 0;
    return ($matched, \@captures);
}

1;