1package Router::Simple;
2use strict;
3use warnings;
4use 5.00800;
5our $VERSION = '0.17';
6use Router::Simple::SubMapper;
7use Router::Simple::Route;
8use List::Util qw/max/;
9use Carp ();
10
11use Class::Accessor::Lite 0.05 (
12    new => 1,
13    ro => [qw(routes directory_slash)],
14);
15
16our $_METHOD_NOT_ALLOWED;
17
18sub connect {
19    my $self = shift;
20
21    if ($self->{directory_slash}) {
22        # connect([$name, ]$pattern[, \%dest[, \%opt]])
23        if (@_ == 1 || ref $_[1]) {
24            unshift(@_, undef);
25        }
26
27        # \%opt
28        $_[3] ||= {};
29        $_[3]->{directory_slash} = 1;
30    }
31
32    my $route = Router::Simple::Route->new(@_);
33    push @{ $self->{routes} }, $route;
34    return $self;
35}
36
37sub submapper {
38    my ($self, $pattern, $dest, $opt) = @_;
39    return Router::Simple::SubMapper->new(
40        parent  => $self,
41        pattern => $pattern,
42        dest    => $dest || +{},
43        opt     => $opt || +{},
44    );
45}
46
47sub _match {
48    my ($self, $env) = @_;
49
50    if (ref $env) {
51        # "I think there was a discussion about that a while ago and it is up to apps to deal with empty PATH_INFO as root / iirc"
52        # -- by @miyagawa
53        #
54        # see http://blog.64p.org/entry/2012/10/05/132354
55        if ($env->{PATH_INFO} eq '') {
56            $env->{PATH_INFO} = '/';
57        }
58    } else {
59        $env = +{ PATH_INFO => $env }
60    }
61
62    local $_METHOD_NOT_ALLOWED;
63    $self->{method_not_allowed} = 0;
64    for my $route (@{$self->{routes}}) {
65        my $match = $route->match($env);
66        return ($match, $route) if $match;
67    }
68    $self->{method_not_allowed} = $_METHOD_NOT_ALLOWED;
69    return undef; # not matched.
70}
71
72sub method_not_allowed {
73    my $self = shift;
74    $self->{method_not_allowed};
75}
76
77sub match {
78    my ($self, $req) = @_;
79    my ($match) = $self->_match($req);
80    return $match;
81}
82
83sub routematch {
84    my ($self, $req) = @_;
85    return $self->_match($req);
86}
87
88sub as_string {
89    my $self = shift;
90
91    my $mn = max(map { $_->{name} ? length($_->{name}) : 0 } @{$self->{routes}});
92    my $nn = max(map { $_->{method} ? length(join(",",@{$_->{method}})) : 0 } @{$self->{routes}});
93
94    return join('', map {
95        sprintf "%-${mn}s %-${nn}s %s\n", $_->{name}||'', join(',', @{$_->{method} || []}) || '', $_->{pattern}
96    } @{$self->{routes}}) . "\n";
97}
98
991;
100__END__
101
102=for stopwords DeNA
103
104=encoding utf8
105
106=head1 NAME
107
108Router::Simple - simple HTTP router
109
110=head1 SYNOPSIS
111
112    use Router::Simple;
113
114    my $router = Router::Simple->new();
115    $router->connect('/', {controller => 'Root', action => 'show'});
116    $router->connect('/blog/{year}/{month}', {controller => 'Blog', action => 'monthly'});
117
118    my $app = sub {
119        my $env = shift;
120        if (my $p = $router->match($env)) {
121            # $p = { controller => 'Blog', action => 'monthly', ... }
122        } else {
123            [404, [], ['not found']];
124        }
125    };
126
127=head1 DESCRIPTION
128
129Router::Simple is a simple router class.
130
131Its main purpose is to serve as a dispatcher for web applications.
132
133Router::Simple can match against PSGI C<$env> directly, which means
134it's easy to use with PSGI supporting web frameworks.
135
136=head1 HOW TO WRITE A ROUTING RULE
137
138=head2 plain string
139
140    $router->connect( '/foo', { controller => 'Root', action => 'foo' } );
141
142=head2 :name notation
143
144    $router->connect( '/wiki/:page', { controller => 'WikiPage', action => 'show' } );
145    ...
146    $router->match('/wiki/john');
147    # => {controller => 'WikiPage', action => 'show', page => 'john' }
148
149':name' notation matches C<qr{([^/]+)}>.
150
151=head2 '*' notation
152
153    $router->connect( '/download/*.*', { controller => 'Download', action => 'file' } );
154    ...
155    $router->match('/download/path/to/file.xml');
156    # => {controller => 'Download', action => 'file', splat => ['path/to/file', 'xml'] }
157
158'*' notation matches C<qr{(.+)}>. You will get the captured argument as
159an array ref for the special key C<splat>.
160
161=head2 '{year}' notation
162
163    $router->connect( '/blog/{year}', { controller => 'Blog', action => 'yearly' } );
164    ...
165    $router->match('/blog/2010');
166    # => {controller => 'Blog', action => 'yearly', year => 2010 }
167
168'{year}' notation matches C<qr{([^/]+)}>, and it will be captured.
169
170=head2 '{year:[0-9]+}' notation
171
172    $router->connect( '/blog/{year:[0-9]+}/{month:[0-9]{2}}', { controller => 'Blog', action => 'monthly' } );
173    ...
174    $router->match('/blog/2010/04');
175    # => {controller => 'Blog', action => 'monthly', year => 2010, month => '04' }
176
177You can specify regular expressions in named captures.
178
179=head2 regexp
180
181    $router->connect( qr{/blog/(\d+)/([0-9]{2})', { controller => 'Blog', action => 'monthly' } );
182    ...
183    $router->match('/blog/2010/04');
184    # => {controller => 'Blog', action => 'monthly', splat => [2010, '04'] }
185
186You can use Perl5's powerful regexp directly, and the captured values
187are stored in the special key C<splat>.
188
189=head1 METHODS
190
191=over 4
192
193=item my $router = Router::Simple->new();
194
195Creates a new instance of Router::Simple.
196
197=item $router->method_not_allowed() : Boolean
198
199This method returns last C<< $router->match() >> call is rejected by HTTP method or not.
200
201=item $router->connect([$name, ] $pattern, \%destination[, \%options])
202
203Adds a new rule to $router.
204
205    $router->connect( '/', { controller => 'Root', action => 'index' } );
206    $router->connect( 'show_entry', '/blog/:id',
207        { controller => 'Blog', action => 'show' } );
208    $router->connect( '/blog/:id', { controller => 'Blog', action => 'show' } );
209    $router->connect( '/comment', { controller => 'Comment', action => 'new_comment' }, {method => 'POST'} );
210
211C<\%destination> will be used by I<match> method.
212
213You can specify some optional things to C<\%options>. The current
214version supports 'method', 'host', and 'on_match'.
215
216=over 4
217
218=item method
219
220'method' is an ArrayRef[String] or String that matches B<REQUEST_METHOD> in $req.
221
222=item host
223
224'host' is a String or Regexp that matches B<HTTP_HOST> in $req.
225
226=item on_match
227
228    $r->connect(
229        '/{controller}/{action}/{id}',
230        {},
231        {
232            on_match => sub {
233                my($env, $match) = @_;
234                $match->{referer} = $env->{HTTP_REFERER};
235                return 1;
236            }
237        }
238    );
239
240A function that evaluates the request. Its signature must be C<<
241($environ, $match) => bool >>. It should return true if the match is
242successful or false otherwise. The first argument is C<$env> which is
243either a PSGI environment or a request path, depending on what you
244pass to C<match> method; the second is the routing variables that
245would be returned if the match succeeds.
246
247The function can modify C<$env> (in case it's a reference) and
248C<$match> in place to affect which variables are returned. This allows
249a wide range of transformations.
250
251=back
252
253=item C<< $router->submapper($path, [\%dest, [\%opt]]) >>
254
255    $router->submapper('/entry/', {controller => 'Entry'})
256
257This method is shorthand for creating new instance of L<Router::Simple::Submapper>.
258
259The arguments will be passed to C<< Router::Simple::SubMapper->new(%args) >>.
260
261=item C<< $match = $router->match($env|$path) >>
262
263Matches a URL against one of the contained routes.
264
265The parameter is either a L<PSGI> $env or a plain string that
266represents a path.
267
268This method returns a plain hashref that would look like:
269
270    {
271        controller => 'Blog',
272        action     => 'daily',
273        year => 2010, month => '03', day => '04',
274    }
275
276It returns undef if no valid match is found.
277
278=item C<< my ($match, $route) = $router->routematch($env|$path); >>
279
280Match a URL against one of the routes contained.
281
282Will return undef if no valid match is found, otherwise a
283result hashref and a L<Router::Simple::Route> object is returned.
284
285=item C<< $router->as_string() >>
286
287Dumps $router as string.
288
289Example output:
290
291    home         GET  /
292    blog_monthly GET  /blog/{year}/{month}
293                 GET  /blog/{year:\d{1,4}}/{month:\d{2}}/{day:\d\d}
294                 POST /comment
295                 GET  /
296
297=back
298
299=head1 AUTHOR
300
301Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>
302
303=head1 THANKS TO
304
305Tatsuhiko Miyagawa
306
307Shawn M Moore
308
309L<routes.py|http://routes.groovie.org/>.
310
311=head1 SEE ALSO
312
313Router::Simple is inspired by L<routes.py|http://routes.groovie.org/>.
314
315L<Path::Dispatcher> is similar, but so complex.
316
317L<Path::Router> is heavy. It depends on L<Moose>.
318
319L<HTTP::Router> has many dependencies. It is not well documented.
320
321L<HTTPx::Dispatcher> is my old one. It does not provide an OO-ish interface.
322
323=head1 THANKS TO
324
325DeNA
326
327=head1 LICENSE
328
329Copyright (C) Tokuhiro Matsuno
330
331This library is free software; you can redistribute it and/or modify
332it under the same terms as Perl itself.
333
334=cut
335