line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright Infomation |
2
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
3
|
|
|
|
|
|
|
# Author : Dr. Ahmed Amin Elsheshtawy, Ph.D. |
4
|
|
|
|
|
|
|
# Website: https://github.com/mewsoft/Nile, http://www.mewsoft.com |
5
|
|
|
|
|
|
|
# Email : mewsoft@cpan.org, support@mewsoft.com |
6
|
|
|
|
|
|
|
# Copyrights (c) 2014-2015 Mewsoft Corp. All rights reserved. |
7
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
8
|
|
|
|
|
|
|
package Nile::Router; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.54'; |
11
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:MEWSOFT'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=pod |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=encoding utf8 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Nile::Router - URL route manager. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# get router object |
24
|
|
|
|
|
|
|
$router = $app->router; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# load routes file from the path/route folder. default file extension is xml. |
27
|
|
|
|
|
|
|
$router->load("route"); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# find route action and its information, result is hash ref |
30
|
|
|
|
|
|
|
my $match = $router->match($route, $request_method); |
31
|
|
|
|
|
|
|
say $match->{action}, |
32
|
|
|
|
|
|
|
$match->{args}, |
33
|
|
|
|
|
|
|
$match->{query}, |
34
|
|
|
|
|
|
|
$match->{uri}, |
35
|
|
|
|
|
|
|
$match->{code}, |
36
|
|
|
|
|
|
|
$match->{route}; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $match = $router->match("/news/world/egypt/politics/2014/07/24/1579279", "get"); |
39
|
|
|
|
|
|
|
my $match = $router->match("/blog/computer/software/article_name"); |
40
|
|
|
|
|
|
|
my $match = $router->match($route, $request_method); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# add new route information to the router object |
43
|
|
|
|
|
|
|
$router->add_route( |
44
|
|
|
|
|
|
|
name => "blogview", |
45
|
|
|
|
|
|
|
path => "blog/view/{id:\d+}", |
46
|
|
|
|
|
|
|
target => "/Blog/Blog/view", # can be a code ref like sub{...} |
47
|
|
|
|
|
|
|
method => "*", # get, post, put, patch, delete, options, head, ajax, * |
48
|
|
|
|
|
|
|
defaults => { |
49
|
|
|
|
|
|
|
id => 1 |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
attributes => "capture", # undef or "capture" for inline actions capture |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 DESCRIPTION |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Nile::Router - URL route manager. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head2 ROUTES FILES |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Routes are stored in a special xml files in the application folder named B<route>. Below is a sample C<route.xml> file. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
<?xml version="1.0" encoding="UTF-8" ?> |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
<register route="/register" action="Accounts/Register/create" method="get" defaults="year=1900|month=1|day=23" /> |
65
|
|
|
|
|
|
|
<post route="/blog/post/{cid:\d+}/{id:\d+}" action="Blog/Article/post" method="post" /> |
66
|
|
|
|
|
|
|
<browse route="/blog/{id:\d+}" action="Blog/Article/browse" method="get" /> |
67
|
|
|
|
|
|
|
<view route="/blog/view/{id:\d+}" action="Blog/Article/view" method="get" /> |
68
|
|
|
|
|
|
|
<edit route="/blog/edit/{id:\d+}" action="Blog/Article/edit" method="get" /> |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Each route entry in the routes file has the following format: |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
<name route="/blog" action="Plugin/Controller/Action" method="get" defaults="k1=v1|k2=v2..." /> |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The following are the components of the route tag: |
75
|
|
|
|
|
|
|
The route 'name', this must be unique name for the route. |
76
|
|
|
|
|
|
|
The url 'route' or path that should match. |
77
|
|
|
|
|
|
|
The 'action' or target which should be executed if route matched the path. |
78
|
|
|
|
|
|
|
The 'method' is optional and if provided will only match the route if request method matched it. Empty or '*' will match all. |
79
|
|
|
|
|
|
|
The 'defaults' is optional and can be used to provide a default values for the route params if not exist. These params if exist will be added to the request params in the request object. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Routes are loaded and matched in the same order they exist in the file, the sort order is kept the same. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
1
|
|
|
1
|
|
6
|
use Nile::Base; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
10
|
|
86
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
87
|
|
|
|
|
|
|
sub BUILD { |
88
|
0
|
|
|
0
|
0
|
|
my ($self, $args) = @_; |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
|
|
|
$self->{cache} = +{}; |
91
|
0
|
|
|
|
|
|
$self->{cache_route} = +{}; |
92
|
0
|
|
|
|
|
|
$self->{routes} = []; |
93
|
0
|
|
|
|
|
|
$self->{patterns} = +{}; |
94
|
0
|
|
|
|
|
|
$self->{names} = +{}; |
95
|
0
|
|
|
|
|
|
$self->{paths_methods} = +{}; |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
$self->{route_counter} = 0; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
100
|
|
|
|
|
|
|
=head2 load() |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# load routes file. default file extension is xml. load route.xml file. |
103
|
|
|
|
|
|
|
$router->load("route"); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# add another routes file. load and add the file blog.xml file. |
106
|
|
|
|
|
|
|
$router->load("blog"); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Loads and adds routes files. Routes files are XML files with specific tags. Everytime you load a route file |
109
|
|
|
|
|
|
|
it will be added to the routes and does not clear the previously loaded files unless you call the clear method. |
110
|
|
|
|
|
|
|
This method can be chained. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub load { |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
0
|
0
|
|
my ($self, $file) = @_; |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
$file .= ".xml" unless ($file =~ /\.xml$/i); |
119
|
0
|
|
|
|
|
|
my $filename = $self->app->file->catfile($self->app->var->get("route_dir"), $file); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# keep routes sorted |
122
|
0
|
|
|
|
|
|
$self->app->xml->keep_order(1); |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $xml = $self->app->xml->get_file($filename); |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
my ($regexp, $capture, $uri_template, $k, $v, $defaults, $key, $val); |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
while (($k, $v) = each %{$xml}) { |
|
0
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# <register route="register" action="Accounts/Register/register" method="get" defaults="year=1900|month=1|day=23" /> |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
0
|
|
|
|
$v->{-defaults} ||= ""; |
132
|
0
|
|
|
|
|
|
$defaults = +{}; |
133
|
0
|
|
|
|
|
|
foreach (split (/\|/, $v->{-defaults})) { |
134
|
0
|
|
|
|
|
|
($key, $val) = split (/\=/, $_); |
135
|
0
|
|
|
|
|
|
$defaults->{$key} = $val; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
$self->add_route( |
139
|
0
|
|
0
|
|
|
|
name => $k, |
140
|
|
|
|
|
|
|
path => $v->{-route}, |
141
|
|
|
|
|
|
|
target => $v->{-action}, |
142
|
|
|
|
|
|
|
method => $v->{-method} || '*', |
143
|
|
|
|
|
|
|
defaults => $defaults, |
144
|
|
|
|
|
|
|
attributes => undef, |
145
|
|
|
|
|
|
|
); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
$self; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
151
|
|
|
|
|
|
|
=head2 match() |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# find route action and its information, result is hash ref |
154
|
|
|
|
|
|
|
my $match = $router->match($route, $request_method); |
155
|
|
|
|
|
|
|
say $match->{action}, |
156
|
|
|
|
|
|
|
$match->{args}, |
157
|
|
|
|
|
|
|
$match->{query}, |
158
|
|
|
|
|
|
|
$match->{uri}, |
159
|
|
|
|
|
|
|
$match->{code}, |
160
|
|
|
|
|
|
|
$match->{route}; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Match routes from the loaded routes files. If route matched returns route target or action, default arguments if provided, |
163
|
|
|
|
|
|
|
and uri and query information. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub match { |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
0
|
0
|
|
my ($self, $route, $method) = @_; |
170
|
|
|
|
|
|
|
|
171
|
0
|
0
|
|
|
|
|
$route || return; |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
my $uri = $self->_match($route, $method); |
174
|
|
|
|
|
|
|
|
175
|
0
|
0
|
|
|
|
|
$uri || return; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# get the full matched route object |
178
|
0
|
|
|
|
|
|
my $matched_route = $self->cash_route($route, $method); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
#my $route = $router->route_for($uri, $method); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# inline actions. $app->action("get", "/home", sub {}); $app->capture("get", "/home", sub {}); |
183
|
0
|
0
|
|
|
|
|
if (ref($uri) eq "CODE") { |
184
|
|
|
|
|
|
|
#return wantarray? ($uri, $route_obj->{attributes}, $route_obj): {action=>$uri, route=>$route_obj->{attributes}}; |
185
|
|
|
|
|
|
|
# ($action, $args, $uri, $query, $code, $matched_route) |
186
|
|
|
|
|
|
|
#return wantarray? ($uri, undef, undef, undef, 1, $matched_route): {action=>$uri, code=>1, route=>$matched_route}; |
187
|
0
|
|
|
|
|
|
return {action=>$uri, args=>undef, query=>undef, uri=>undef, code=>1, route=>$matched_route}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
#$uri = /blog/view/?lang=en&locale=us&Article=Home |
191
|
0
|
|
|
|
|
|
my ($action, $query) = split (/\?/, $uri); |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
my ($args, $k, $v); |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
0
|
|
|
|
$query ||= ""; |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
foreach (split(/&/, $query)) { |
198
|
0
|
|
|
|
|
|
($k, $v) = split (/=/, $_); |
199
|
0
|
|
|
|
|
|
$args->{$k} = $self->url_decode($v); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
#return wantarray? ($action, $args, $uri, $query, 0, $matched_route) : {action=>$action, args=>$args, query=>$query, uri=>$uri, code=>0, route=>$matched_route}; |
203
|
0
|
|
|
|
|
|
return {action=>$action, args=>$args, query=>$query, uri=>$uri, code=>0, route=>$matched_route}; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
206
|
|
|
|
|
|
|
sub _match { |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
0
|
|
|
my ($self, $full_uri, $method) = @_; |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
0
|
|
|
|
$method ||= '*'; |
211
|
0
|
|
|
|
|
|
$method = uc($method); |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
my ($uri, $querystring) = split /\?/, $full_uri; |
214
|
|
|
|
|
|
|
|
215
|
0
|
0
|
|
|
|
|
if (exists( $self->{cache}->{"$method $full_uri"})) { |
216
|
|
|
|
|
|
|
|
217
|
0
|
0
|
|
|
|
|
if (ref($self->{cache}->{"$method $full_uri"})) { |
218
|
0
|
0
|
|
|
|
|
return wantarray ? @{ $self->{cache}->{"$method $full_uri"} } : $self->{cache}->{"$method $full_uri"}; |
|
0
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
else { |
221
|
0
|
0
|
|
|
|
|
return unless defined $self->{cache}->{"$method $full_uri"}; |
222
|
0
|
|
|
|
|
|
return $self->{cache}->{"$method $full_uri"}; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
0
|
0
|
0
|
|
|
|
foreach my $route (grep { $method eq '*' || $_->{method} eq $method || $_->{method} eq '*' } @{$self->{routes}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
228
|
0
|
0
|
|
|
|
|
if (my @captured = ($uri =~ $route->{regexp})) { |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# cash the full matched route |
231
|
0
|
|
|
|
|
|
$self->{cache_route}->{"$method $full_uri"} = $route; |
232
|
|
|
|
|
|
|
|
233
|
0
|
0
|
|
|
|
|
if (ref($route->{target}) eq 'ARRAY') { |
234
|
0
|
|
|
|
|
|
$self->{cache}->{"$method $full_uri"} = [ |
235
|
|
|
|
|
|
|
map { |
236
|
0
|
|
|
|
|
|
$self->_prepare_target( $route, $_, $querystring, @captured) |
237
|
0
|
|
|
|
|
|
} @{ $route->{target} } |
238
|
|
|
|
|
|
|
]; |
239
|
0
|
0
|
|
|
|
|
return wantarray ? @{ $self->{cache}->{"$method $full_uri"} } : $self->{cache}->{"$method $uri"}; |
|
0
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
else { |
242
|
|
|
|
|
|
|
#return $s->{cache}->{"$method $full_uri"} = $s->_prepare_target($route, "$route->{target}", $querystring, @captured); |
243
|
0
|
|
|
|
|
|
return $self->{cache}->{"$method $full_uri"} = $self->_prepare_target($route, $route->{target}, $querystring, @captured); |
244
|
|
|
|
|
|
|
}# end if() |
245
|
|
|
|
|
|
|
}# end if() |
246
|
|
|
|
|
|
|
}# end foreach() |
247
|
|
|
|
|
|
|
|
248
|
0
|
|
|
|
|
|
$self->{cache}->{"$method $uri"} = undef; |
249
|
0
|
|
|
|
|
|
return; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
252
|
|
|
|
|
|
|
sub cash_route { |
253
|
0
|
|
|
0
|
0
|
|
my ($self, $uri, $method) = @_; |
254
|
0
|
|
|
|
|
|
return $self->{cache_route}->{"$method $uri"}; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
257
|
|
|
|
|
|
|
sub _prepare_target { |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
0
|
|
|
my ($self, $route, $target, $querystring, @captured) = @_; |
260
|
|
|
|
|
|
|
|
261
|
0
|
0
|
|
|
|
|
$querystring = '' unless defined($querystring); |
262
|
|
|
|
|
|
|
|
263
|
1
|
|
|
1
|
|
6313
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2134
|
|
264
|
0
|
|
|
|
|
|
my $values = {map { my ($k,$v) = split /\=/, $_; ($k => $v) } split /&/, $querystring}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
|
my %defaults = %{ $route->{defaults} }; |
|
0
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
0
|
0
|
|
|
|
|
map { |
269
|
0
|
|
|
|
|
|
my $value = @captured ? shift(@captured) : $defaults{$_}; |
270
|
0
|
|
|
|
|
|
$value =~ s/\/$//; |
271
|
0
|
0
|
|
|
|
|
$value = $defaults{$_} unless length($value); |
272
|
0
|
|
|
|
|
|
$values->{$_} = $value; |
273
|
0
|
0
|
|
|
|
|
delete($defaults{$_}) if exists $defaults{$_}; |
274
|
0
|
|
|
|
|
|
} @{$route->{captures}}; |
275
|
|
|
|
|
|
|
|
276
|
0
|
|
|
|
|
|
map { $target =~ s/\[\:\Q$_\E\:\]/$values->{$_}/g } keys %$values; |
|
0
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
my %skip = ( ); |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
|
my $form_params = join '&', grep { $_ } map { |
|
0
|
|
|
|
|
|
|
281
|
0
|
|
|
|
|
|
$skip{$_}++; |
282
|
0
|
0
|
|
|
|
|
url_encode($_) . '=' . url_encode($values->{$_}) if defined($values->{$_}); |
283
|
0
|
|
|
|
|
|
} grep { defined($values->{$_}) } sort {lc($a) cmp lc($b)} keys %$values; |
|
0
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
0
|
0
|
|
|
|
|
my $default_params = join '&', map { |
286
|
0
|
0
|
|
|
|
|
url_encode($_) . '=' . url_encode($defaults{$_}) if defined($defaults{$_}); |
287
|
0
|
|
|
|
|
|
} grep { defined($defaults{$_}) && ! $skip{$_} } sort {lc($a) cmp lc($b)} keys %defaults; |
|
0
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
|
289
|
0
|
|
|
|
|
|
my $params = join '&', (grep { $_ } $form_params, $default_params); |
|
0
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
|
291
|
0
|
0
|
|
|
|
|
if ($target =~ m/\?/) { |
292
|
0
|
0
|
|
|
|
|
return $target . ($params ? "&$params" : "" ); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
else { |
295
|
|
|
|
|
|
|
#return $target . ($params ? "?$params" : "" ); |
296
|
0
|
0
|
|
|
|
|
if ($params) { $target .= "?$params"; }; |
|
0
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
return $target; |
298
|
|
|
|
|
|
|
}# end if() |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
302
|
|
|
|
|
|
|
=head2 uri_for() |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my $route = $router->uri_for($route_name, \%params); |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Returns the uri for a given route with the provided params. |
307
|
|
|
|
|
|
|
=cut |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub uri_for { |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
0
|
0
|
|
my ($self, $name, $args) = @_; |
312
|
|
|
|
|
|
|
|
313
|
0
|
0
|
|
|
|
|
confess "Unknown route '$name'." unless my $route = $self->{names}->{$name}; |
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
my $template = $route->{uri_template}; |
316
|
|
|
|
|
|
|
|
317
|
0
|
0
|
|
|
|
|
map { |
318
|
0
|
|
|
|
|
|
$args->{$_} = $route->{defaults}->{$_} unless defined($args->{$_}) |
319
|
0
|
|
|
|
|
|
} keys %{$route->{defaults}}; |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
|
my %used = ( ); |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
|
map { |
324
|
0
|
|
|
|
|
|
$template =~ s! |
325
|
|
|
|
|
|
|
\[\:$_\:\](\/?) |
326
|
|
|
|
|
|
|
! |
327
|
0
|
0
|
0
|
|
|
|
if (defined($args->{$_}) && length($args->{$_})) { |
328
|
0
|
|
|
|
|
|
$used{$_}++; |
329
|
0
|
|
|
|
|
|
"$args->{$_}$1" |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
else { |
332
|
0
|
|
|
|
|
|
""; |
333
|
|
|
|
|
|
|
}# end if() |
334
|
|
|
|
|
|
|
!egx |
335
|
0
|
|
|
|
|
|
} @{$route->{captures}}; |
336
|
|
|
|
|
|
|
|
337
|
0
|
0
|
0
|
|
|
|
my $params = join '&', map { url_encode($_) . '=' . url_encode($args->{$_}) } |
|
0
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
grep { defined($args->{$_}) && length($args->{$_}) && ! $used{$_} } keys %$args; |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
|
if (length($params)) { |
341
|
0
|
0
|
|
|
|
|
$template .= $template =~ m/\?/ ? "&$params" : "?$params"; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
return $template; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
347
|
|
|
|
|
|
|
=head2 route_for() |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
my $route = $router->route_for($path, [$method]); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Returns the route matching the path and method. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub route_for { |
356
|
|
|
|
|
|
|
|
357
|
0
|
|
|
0
|
0
|
|
my ($self, $uri, $method) = @_; |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
0
|
|
|
|
$method ||= '*'; |
360
|
0
|
|
|
|
|
|
$method = uc($method); |
361
|
|
|
|
|
|
|
|
362
|
0
|
0
|
|
|
|
|
($uri) = split /\?/, $uri or return; |
363
|
|
|
|
|
|
|
|
364
|
0
|
0
|
0
|
|
|
|
foreach my $route (grep {$method eq '*' || $_->{method} eq $method || $_->{method} eq '*'} @{$self->{routes}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
365
|
0
|
0
|
|
|
|
|
if (my @captured = ($uri =~ $route->{regexp})) { |
366
|
0
|
|
|
|
|
|
return $route; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
0
|
|
|
|
|
|
return; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
373
|
|
|
|
|
|
|
=head2 add_route() |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# add new route information to the router object |
376
|
|
|
|
|
|
|
$router->add_route( |
377
|
|
|
|
|
|
|
name => "blogview", |
378
|
|
|
|
|
|
|
path => "blog/view/{id:\d+}", |
379
|
|
|
|
|
|
|
target => "/Blog/Blog/view", # can be a code ref like sub{...} |
380
|
|
|
|
|
|
|
method => "*", # get, post, put, patch, delete, options, head, ajax, * |
381
|
|
|
|
|
|
|
defaults => { |
382
|
|
|
|
|
|
|
id => 1 |
383
|
|
|
|
|
|
|
}, |
384
|
|
|
|
|
|
|
attributes => "capture", # undef or "capture" for inline actions capture |
385
|
|
|
|
|
|
|
); |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
This method adds a new route information to the routing table. Routes must be unique, so you can't have two routes that both look like /blog/:id for example. |
388
|
|
|
|
|
|
|
An exception will be thrown if an attempt is made to add a route that already exists. |
389
|
|
|
|
|
|
|
If route name is empty, a custom route name in the form C<__ROUTE__[number]> will be used. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=cut |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub add_route { |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
0
|
0
|
|
my ($self, %args) = @_; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
0
|
|
|
|
$args{name} ||= "__ROUTE__" . ++$self->{route_counter}; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# Set the method: |
400
|
0
|
|
0
|
|
|
|
$args{method} ||= '*'; |
401
|
0
|
|
|
|
|
|
$args{method} = uc($args{method}); |
402
|
|
|
|
|
|
|
|
403
|
0
|
|
|
|
|
|
my $uid = "$args{method} $args{path}"; |
404
|
0
|
|
|
|
|
|
my $starUID = "* $args{path}"; |
405
|
|
|
|
|
|
|
|
406
|
0
|
0
|
0
|
|
|
|
confess "Required param 'path' was not provided." unless defined($args{path}) && length($args{path}); |
407
|
|
|
|
|
|
|
|
408
|
0
|
0
|
0
|
|
|
|
confess "Required param 'target' was not provided." unless defined($args{target}) && length($args{target}); |
409
|
|
|
|
|
|
|
|
410
|
0
|
0
|
0
|
|
|
|
confess "Required param 'name' was not provided." unless defined($args{name}) && length($args{name}); |
411
|
|
|
|
|
|
|
|
412
|
0
|
0
|
|
|
|
|
if (exists($self->{names}->{$args{name}})) { |
413
|
0
|
|
|
|
|
|
confess "name '$args{name}' is already in use by '$self->{names}->{$args{name}}->{path}'."; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
0
|
0
|
|
|
|
|
if (exists($self->{paths_methods}->{$uid})) { |
417
|
0
|
|
|
|
|
|
confess "path '$args{method} $args{path}' conflicts with pre-existing path '$self->{paths_methods}->{$uid}->{method} $self->{paths_methods}->{$uid}->{path}'." |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
0
|
0
|
|
|
|
|
if (exists($self->{paths_methods}->{$starUID})) { |
421
|
0
|
|
|
|
|
|
confess "name '* $args{name}' is already in use by '$self->{paths_methods}->{$starUID}->{method} $self->{paths_methods}->{$starUID}->{path}'." |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
0
|
|
0
|
|
|
|
$args{defaults} ||= {}; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
($args{regexp}, $args{captures}, $args{uri_template}) = $self->_patternize( $args{path} ); |
427
|
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
my $regUID = "$args{method} " . $args{regexp}; |
429
|
|
|
|
|
|
|
|
430
|
0
|
0
|
|
|
|
|
if (my $exists = $self->{patterns}->{$regUID}) { |
431
|
0
|
|
|
|
|
|
confess "path '$args{path}' conflicts with pre-existing path '$exists'."; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
push @{$self->{routes}}, \%args; |
|
0
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
|
436
|
0
|
|
|
|
|
|
$self->{patterns}->{$regUID} = $args{path}; |
437
|
0
|
|
|
|
|
|
$self->{names}->{$args{name}} = $self->{routes}->[-1]; |
438
|
0
|
|
|
|
|
|
$self->{paths_methods}->{$uid} = $self->{routes}->[-1]; |
439
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
|
$self; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
443
|
|
|
|
|
|
|
sub _patternize { |
444
|
|
|
|
|
|
|
|
445
|
0
|
|
|
0
|
|
|
my ($self, $path) = @_; |
446
|
|
|
|
|
|
|
|
447
|
0
|
|
|
|
|
|
my @captures = (); |
448
|
|
|
|
|
|
|
|
449
|
0
|
|
|
|
|
|
my $regexp = do { |
450
|
0
|
|
|
|
|
|
(my $copy = $path) =~ s! |
451
|
|
|
|
|
|
|
\{(\w+\:(?:\{[0-9,]+\}|[^{}]+)+)\} | # /foo/{Page:\d+} |
452
|
|
|
|
|
|
|
:([^/\{\}\:\-]+) | # /foo/:title |
453
|
|
|
|
|
|
|
\{([^\}]+)\} | # /foo/{Bar} and /foo/{*WhateverElse} |
454
|
|
|
|
|
|
|
([^/\{\}\:\-]+) # /foo/literal/ |
455
|
|
|
|
|
|
|
! |
456
|
0
|
0
|
|
|
|
|
if ($1) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
457
|
0
|
|
|
|
|
|
my ($name, $pattern) = split /:/, $1; |
458
|
0
|
|
|
|
|
|
push @captures, $name; |
459
|
0
|
0
|
|
|
|
|
$pattern ? "($pattern)" : "([^/]*?)"; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
elsif ($2) { |
462
|
0
|
|
|
|
|
|
push @captures, $2; |
463
|
0
|
|
|
|
|
|
"([^/]*?)"; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
elsif ($3) { |
466
|
0
|
|
|
|
|
|
my $part = $3; |
467
|
0
|
0
|
|
|
|
|
if ($part =~ m/^\*/) { |
468
|
0
|
|
|
|
|
|
$part =~ s/^\*//; |
469
|
0
|
|
|
|
|
|
push @captures, $part; |
470
|
0
|
|
|
|
|
|
"(.*?)"; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
else { |
473
|
0
|
|
|
|
|
|
push @captures, $part; |
474
|
0
|
|
|
|
|
|
"([^/]*?)"; |
475
|
|
|
|
|
|
|
}# end if() |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
elsif ($4) { |
478
|
0
|
|
|
|
|
|
quotemeta($4); |
479
|
|
|
|
|
|
|
}# end if() |
480
|
|
|
|
|
|
|
!sgxe; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# Make the trailing '/' optional: |
483
|
0
|
0
|
|
|
|
|
unless($copy =~ m{\/[^/]+\.[^/]+$}) { |
484
|
0
|
0
|
|
|
|
|
$copy .= '/' unless $copy =~ m/\/$/; |
485
|
0
|
|
|
|
|
|
$copy =~ s{\/$}{\/?}; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
qr{^$copy$}; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
}; |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# This tokenized string becomes a template for the 'uri_for(...)' method: |
493
|
0
|
|
|
|
|
|
my $uri_template = do { |
494
|
0
|
|
|
|
|
|
(my $copy = $path) =~ s! |
495
|
|
|
|
|
|
|
\{(\w+\:(?:\{[0-9,]+\}|[^{}]+)+)\} | # /foo/{Page:\d+} |
496
|
|
|
|
|
|
|
:([^/\{\}\:\-]+) | # /foo/:title |
497
|
|
|
|
|
|
|
\{([^\}]+)\} | # /foo/{Bar} and /foo/{*WhateverElse} |
498
|
|
|
|
|
|
|
([^/\{\}\:\-]+) # /foo/literal/ |
499
|
|
|
|
|
|
|
! |
500
|
0
|
0
|
|
|
|
|
if ($1) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
501
|
0
|
|
|
|
|
|
my ($name, $pattern) = split /:/, $1; |
502
|
0
|
|
|
|
|
|
"[:$name:]"; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
elsif ($2) { |
505
|
0
|
|
|
|
|
|
"[:$2:]"; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
elsif ($3) { |
508
|
0
|
|
|
|
|
|
my $part = $3; |
509
|
0
|
0
|
|
|
|
|
if ($part =~ m/^\*/) { |
510
|
0
|
|
|
|
|
|
$part =~ s/^\*//; |
511
|
0
|
|
|
|
|
|
"[:$part:]" |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
else { |
514
|
0
|
|
|
|
|
|
"[:$part:]" |
515
|
|
|
|
|
|
|
}# end if() |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
elsif ($4) { |
518
|
0
|
|
|
|
|
|
$4; |
519
|
|
|
|
|
|
|
}# end if() |
520
|
|
|
|
|
|
|
!sgxe; |
521
|
|
|
|
|
|
|
|
522
|
0
|
0
|
|
|
|
|
unless ($copy =~ m{\/[^/]+\.[^/]+$}) { |
523
|
0
|
0
|
|
|
|
|
$copy .= '/' unless $copy =~ m/\/$/; |
524
|
0
|
|
|
|
|
|
$copy =~ s{\/$}{\/?}; |
525
|
0
|
|
|
|
|
|
$copy =~ s/\?$//; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
0
|
|
|
|
|
|
$copy; |
529
|
|
|
|
|
|
|
}; |
530
|
|
|
|
|
|
|
|
531
|
0
|
|
|
|
|
|
return ($regexp, \@captures, $uri_template); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
534
|
|
|
|
|
|
|
sub replace_route { |
535
|
0
|
|
|
0
|
0
|
|
my ($self, %args) = @_; |
536
|
0
|
0
|
|
|
|
|
$self->add_route(%args) unless eval { $self->uri_for($args{name}) }; |
|
0
|
|
|
|
|
|
|
537
|
0
|
|
|
|
|
|
$self; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
540
|
|
|
|
|
|
|
=head2 url_decode() |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
my $decode_url = $router->url_decode($url); |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=cut |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub url_decode { |
547
|
0
|
|
|
0
|
0
|
|
my ( $self, $decode ) = @_; |
548
|
0
|
0
|
|
|
|
|
return () unless defined $decode; |
549
|
0
|
|
|
|
|
|
$decode =~ tr/+/ /; |
550
|
0
|
|
|
|
|
|
$decode =~ s/%([a-fA-F0-9]{2})/ pack "C", hex $1 /eg; |
|
0
|
|
|
|
|
|
|
551
|
0
|
|
|
|
|
|
return $decode; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
554
|
|
|
|
|
|
|
=head2 url_encode() |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
my $encoded_url = $router->url_encode($url); |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=cut |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
sub url_encode { |
561
|
0
|
|
|
0
|
0
|
|
my ( $self, $encode ) = @_; |
562
|
0
|
0
|
|
|
|
|
return () unless defined $encode; |
563
|
0
|
|
|
|
|
|
$encode =~ s/([^A-Za-z0-9\-_.!~*'() ])/ uc sprintf "%%%02x",ord $1 /eg; |
|
0
|
|
|
|
|
|
|
564
|
0
|
|
|
|
|
|
$encode =~ tr/ /+/; |
565
|
0
|
|
|
|
|
|
return $encode; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=pod |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head1 Bugs |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
This project is available on github at L<https://github.com/mewsoft/Nile>. |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head1 HOMEPAGE |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Please visit the project's homepage at L<https://metacpan.org/release/Nile>. |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=head1 SOURCE |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Source repository is at L<https://github.com/mewsoft/Nile>. |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head1 SEE ALSO |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
See L<Nile> for details about the complete framework. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head1 AUTHOR |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Ahmed Amin Elsheshtawy, اØÙ
د اÙ
Ù٠اÙششتاÙÙ <mewsoft@cpan.org> |
590
|
|
|
|
|
|
|
Website: http://www.mewsoft.com |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
Copyright (C) 2014-2015 by Dr. Ahmed Amin Elsheshtawy اØÙ
د اÙ
Ù٠اÙششتاÙÙ mewsoft@cpan.org, support@mewsoft.com, |
595
|
|
|
|
|
|
|
L<https://github.com/mewsoft/Nile>, L<http://www.mewsoft.com> |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=cut |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
1; |