File Coverage

blib/lib/CatalystX/TraitFor/Dispatcher/ExactMatch.pm
Criterion Covered Total %
statement 14 14 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 19 19 100.0


line stmt bran cond sub pod time code
1 1     1   20726 use 5.010;
  1         3  
  1         39  
2 1     1   5 use strict;
  1         2  
  1         30  
3 1     1   4 use warnings;
  1         6  
  1         48  
4              
5             package CatalystX::TraitFor::Dispatcher::ExactMatch;
6              
7 1     1   3301 use Moose::Role;
  1         666402  
  1         7  
8              
9             BEGIN
10             {
11 1     1   6730 $CatalystX::TraitFor::Dispatcher::ExactMatch::AUTHORITY = 'cpan:TOBYINK';
12 1         428 $CatalystX::TraitFor::Dispatcher::ExactMatch::VERSION = '0.003';
13             }
14              
15             requires qw( dispatch_types );
16              
17             around prepare_action => sub
18             {
19             my $next = shift;
20             my $self = shift;
21             my ($ctx, @etc) = @_;
22            
23             my $req = $ctx->req;
24             (my $path = $req->path) =~ s{^/+}{};
25            
26             my $matched = 0;
27             foreach my $type ( @{ $self->dispatch_types } )
28             {
29             if (!$matched and $type->match($ctx, $path))
30             {
31             $matched++;
32             }
33             }
34            
35             if ($matched)
36             {
37             $ctx->log->debug(sprintf('Got exact match "%s"', $req->match));
38             s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg foreach grep { defined } @{$req->captures||[]};
39             }
40            
41             $self->$next($ctx, @etc);
42             };
43              
44             'fixed';
45              
46             __END__
47              
48             =head1 NAME
49              
50             CatalystX::TraitFor::Dispatcher::ExactMatch - handle trailing slashes properly
51              
52             =head1 SYNOPSIS
53              
54             package MyApp;
55            
56             use Catalyst::Runtime 5.80;
57             use Catalyst qw/
58             -Debug
59             Static::Simple
60             /;
61             use CatalystX::RoleApplicator;
62            
63             __PACKAGE__->apply_dispatcher_class_roles(
64             qw/CatalystX::TraitFor::Dispatcher::ExactMatch/
65             );
66              
67             =head1 DESCRIPTION
68              
69             The Catalyst dispatcher doesn't differentiate between:
70              
71             =over
72              
73             =item C<http://localhost:3000/foo>
74              
75             =item C<http://localhost:3000/foo/>
76              
77             =back
78              
79             Not even with Regex dispatching. Not even by writing a custom dispatch
80             type.
81              
82             This is apparently a "feature". As far as I'm concerned, it's a bug.
83              
84             This trait for Catalyst::Dispatcher attempts to perform an exact match,
85             including trailing slashes, ahead of Catalyst's default dispatching. It's
86             not been tested in every possible configuration, but it works for me.
87              
88             =head1 BUGS
89              
90             Please report any bugs to
91             L<http://rt.cpan.org/Dist/Display.html?Queue=CatalystX-TraitFor-Dispatcher-ExactMatch>.
92              
93             =head1 SEE ALSO
94              
95             L<CatalystX::RoleApplicator>,
96             L<Catalyst::Dispatcher>.
97              
98             L<Catalyst::Plugin::SanitizeUrl> appears to do something similar for
99             pre-Moose versions of Catalyst.
100              
101             =head1 AUTHOR
102              
103             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
104              
105             =head1 COPYRIGHT AND LICENCE
106              
107             This software is copyright (c) 2011, 2014 by Toby Inkster.
108              
109             This is free software; you can redistribute it and/or modify it under
110             the same terms as the Perl 5 programming language system itself.
111              
112             =head1 DISCLAIMER OF WARRANTIES
113              
114             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
115             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
116             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
117