File Coverage

blib/lib/Thunderhorse/Router/Location.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	18	20	90.0
condition	11	13	84.6
subroutine	10	10	100.0
pod	2	3	66.6
total	96	101	95.0

package Thunderhorse::Router::Location;
$Thunderhorse::Router::Location::VERSION = '0.102';
use v5.40;
use Mooish::Base -standard;

use Gears::X::Thunderhorse;
use Thunderhorse qw(build_handler adapt_pagi);

extends 'Gears::Router::Location::SigilMatch';

has option 'action' => (
	isa => Str,
);

has field '_action_re' => (
	isa => RegexpRef,
	lazy => 1,
);

has param 'name' => (
	isa => Str,
	lazy => 1,
);

has param 'to' => (
	isa => Str | CodeRef,
	required => 0,
);

has param 'order' => (
	isa => Int,
	default => 0,
);

has param 'pagi' => (
	isa => Bool,
	default => false,
);

has param 'pagi_middleware' => (
	isa => CodeRef,
	required => 0,
);

has param 'controller' => (
	isa => InstanceOf ['Thunderhorse::Controller'],
);

has field 'pagi_app' => (
	isa => CodeRef,
	lazy => 1,
);

sub BUILD ($self, $)
{
	Gears::X::Thunderhorse->raise('controller has no method ' . $self->to)
		if defined $self->to && !$self->get_destination;

	# register the route in the router
	$self->router->_register_location($self->name, $self);
}

sub _build_action_re ($self)
{
	my ($scope, $method) = split /\./, $self->action;
	$scope = $scope eq '*' ? qr{[^.]+} : quotemeta lc $scope;

	if (($method // '*') eq '*') {
		$method = qr{(\.[^.]+)?};
	}
	elsif (lc $method eq 'get') {
		$method = '[.](get|head)';
	}
	else {
		$method = quotemeta lc ".$method";
	}

	return qr{^$scope$method$};
}

sub _build_name ($self)
{
	my $action = $self->action // 'any';
	my $pattern = $self->pattern;
	my $id = $self->router->_get_next_route_id;

	# autogenerated location name should be readable, but unique
	return "${id}_${action}_${pattern}";
}

sub _build_pagi_app ($self)
{
	# TODO: add router sealing when the app is started (prevent it from
	# changing and breaking assumptions)

	# this needs to be checked lazily, because we don't know if this is a
	# bridge in BUILD
	Gears::X::Thunderhorse->raise('PAGI apps cannot be bridges')
		if $self->pagi && $self->is_bridge;

	my $pagi = $self->pagi
		? adapt_pagi($self->get_destination)
		: build_handler($self->controller, $self->get_destination)
		;

	if (my $mw = $self->pagi_middleware) {
		$pagi = $mw->($pagi);
	}

	return $pagi;
}

sub get_destination ($self)
{
	my $to = $self->to;
	return undef unless defined $to;

	return $to if ref $to eq 'CODE';
	return $self->controller->can($self->to);
}

sub compare ($self, $path, $action)
{
	return undef if $self->has_action && $action !~ $self->_action_re;
	return $self->SUPER::compare($path);
}

__END__