/usr/share/perl5/Web/Dispatch.pm is in libweb-simple-perl 0.020-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | package Web::Dispatch;
use Sub::Quote;
use Scalar::Util qw(blessed);
sub MAGIC_MIDDLEWARE_KEY { __PACKAGE__.'.middleware' }
use Moo;
use Web::Dispatch::Parser;
use Web::Dispatch::Node;
with 'Web::Dispatch::ToApp';
has app => (is => 'ro', required => 1);
has parser_class => (
is => 'ro', default => quote_sub q{ 'Web::Dispatch::Parser' }
);
has node_class => (
is => 'ro', default => quote_sub q{ 'Web::Dispatch::Node' }
);
has node_args => (is => 'ro', default => quote_sub q{ {} });
has _parser => (is => 'lazy');
sub _build__parser {
my ($self) = @_;
$self->parser_class->new;
}
sub call {
my ($self, $env) = @_;
my $res = $self->_dispatch($env, $self->app);
return $res->[0] if ref($res) eq 'ARRAY' and @{$res} == 1 and ref($res->[0]) eq 'CODE';
return $res;
}
sub _dispatch {
my ($self, $env, @match) = @_;
while (defined(my $try = shift @match)) {
return $try if ref($try) eq 'ARRAY';
if (ref($try) eq 'HASH') {
$env = { 'Web::Dispatch.original_env' => $env, %$env, %$try };
next;
}
my @result = $self->_to_try($try, \@match)->($env, @match);
next unless @result and defined($result[0]);
my $first = $result[0];
if (my $res = $self->_have_result($first, \@result, \@match, $env)) {
return $res;
}
# make a copy so we don't screw with it assigning further up
my $env = $env;
unshift @match, sub { $self->_dispatch($env, @result) };
}
return;
}
sub _have_result {
my ($self, $first, $result, $match, $env) = @_;
if (ref($first) eq 'ARRAY') {
return $first;
}
elsif (blessed($first) && $first->isa('Plack::Middleware')) {
return $self->_uplevel_middleware($first, $result);
}
elsif (ref($first) eq 'HASH' and $first->{+MAGIC_MIDDLEWARE_KEY}) {
return $self->_redispatch_with_middleware($first, $match, $env);
}
elsif (
blessed($first) &&
not($first->can('to_app')) &&
not($first->isa('Web::Dispatch::Matcher'))
) {
return $first;
}
return;
}
sub _uplevel_middleware {
my ($self, $match, $results) = @_;
die "Multiple results but first one is a middleware ($match)"
if @{$results} > 1;
# middleware needs to uplevel exactly once to wrap the rest of the
# level it was created for - next elsif unwraps it
return { MAGIC_MIDDLEWARE_KEY, $match };
}
sub _redispatch_with_middleware {
my ($self, $first, $match, $env) = @_;
my $mw = $first->{+MAGIC_MIDDLEWARE_KEY};
$mw->app(sub { $self->_dispatch($_[0], @{$match}) });
return $mw->to_app->($env);
}
sub _to_try {
my ($self, $try, $more) = @_;
# sub (<spec>) {} becomes a dispatcher
# sub {} is a PSGI app and can be returned as is
# '<spec>' => sub {} becomes a dispatcher
# $obj isa WD:Predicates::Matcher => sub { ... } - become a dispatcher
# $obj w/to_app method is a Plack::App-like thing - call it to get a PSGI app
#
if (ref($try) eq 'CODE') {
if (defined(my $proto = prototype($try))) {
$self->_construct_node(match => $proto, run => $try)->to_app;
} else {
$try
}
} elsif (!ref($try) and ref($more->[0]) eq 'CODE') {
$self->_construct_node(match => $try, run => shift(@$more))->to_app;
} elsif (
(blessed($try) && $try->isa('Web::Dispatch::Matcher'))
and (ref($more->[0]) eq 'CODE')
) {
$self->node_class->new({
%{$self->node_args},
match => $try,
run => shift(@$more)
})->to_app;
} elsif (blessed($try) && $try->can('to_app')) {
$try->to_app;
} else {
die "No idea how we got here with $try";
}
}
sub _construct_node {
my ($self, %args) = @_;
$args{match} = $self->_parser->parse($args{match});
$self->node_class->new({ %{$self->node_args}, %args });
}
1;
|