File Coverage

blib/lib/Pinto/Server/Router.pm
Criterion Covered Total %
statement 25 25 100.0
branch 1 2 50.0
condition n/a
subroutine 6 6 100.0
pod 1 2 50.0
total 33 35 94.2


line stmt bran cond sub pod time code
1             # ABSTRACT: Routes server requests
2              
3             package Pinto::Server::Router;
4              
5 13     13   88 use Moose;
  13         43  
  13         431  
6              
7 13     13   88140 use Scalar::Util;
  13         26  
  13         626  
8 13     13   5825 use Plack::Request;
  13         492098  
  13         1074  
9 13     13   3787 use Router::Simple;
  13         47389  
  13         2897  
10              
11             #-------------------------------------------------------------------------------
12              
13             our $VERSION = '0.14'; # VERSION
14              
15             #-------------------------------------------------------------------------------
16              
17             has route_handler => (
18             is => 'ro',
19             isa => 'Router::Simple',
20             default => sub { Router::Simple->new },
21             );
22              
23             #-------------------------------------------------------------------------------
24              
25             sub BUILD {
26 13     13 0 48 my ($self) = @_;
27              
28 13         527 my $r = $self->route_handler;
29              
30 13         184 $r->connect( '/action/{action}', { responder => 'Action' }, { method => 'POST' } );
31              
32 13         1902 $r->connect( '/*', { responder => 'File' }, { method => [ 'GET', 'HEAD' ] } );
33              
34 13         1871 return $self;
35             }
36              
37             #-------------------------------------------------------------------------------
38              
39              
40             sub route {
41 140     140 1 515 my ( $self, $env, $root ) = @_;
42              
43 140 50       4271 my $p = $self->route_handler->match($env)
44             or return [ 404, [], ['Not Found'] ];
45              
46 140         13912 my $responder_class = 'Pinto::Server::Responder::' . $p->{responder};
47 140         1016 Class::Load::load_class($responder_class);
48              
49 140         8508 my $request = Plack::Request->new($env);
50 140         6740 my $responder = $responder_class->new( request => $request, root => $root );
51              
52             # HACK: Plack-1.02 calls URI::Escape::uri_escape() with arguments
53             # that inadvertently cause $_ to be compiled into a regex. This
54             # will emit warning if $_ is undef, or may blow up if it contains
55             # certain stuff. To avoid this, just make sure $_ is empty for
56             # now. A patch has been sent to Miyagawa.
57 140         401 local $_ = '';
58              
59 140         670 return $responder->respond;
60             }
61              
62             #-------------------------------------------------------------------------------
63              
64             __PACKAGE__->meta->make_immutable;
65              
66             #-------------------------------------------------------------------------------
67              
68             1;
69              
70             __END__
71              
72             =pod
73              
74             =encoding UTF-8
75              
76             =for :stopwords Jeffrey Ryan Thalhammer responder
77              
78             =head1 NAME
79              
80             Pinto::Server::Router - Routes server requests
81              
82             =head1 VERSION
83              
84             version 0.14
85              
86             =head1 METHODS
87              
88             =head2 route( $env, $root )
89              
90             Given the request environment and the path to the repository root,
91             dispatches the request to the appropriate responder and returns the
92             response.
93              
94             =for Pod::Coverage BUILD
95              
96             =head1 AUTHOR
97              
98             Jeffrey Ryan Thalhammer <jeff@stratopan.com>
99              
100             =head1 COPYRIGHT AND LICENSE
101              
102             This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
103              
104             This is free software; you can redistribute it and/or modify it under
105             the same terms as the Perl 5 programming language system itself.
106              
107             =cut