Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
New module Plackdo::App::URLMap
Add the URLMap component, which routes requests to different apps based on the host name and path.
- Loading branch information
Showing
3 changed files
with
172 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Original file line | Diff line number | Diff line change |
---|---|---|---|
@@ -0,0 +1,40 @@ | |||
use v6; | |||
use Plackdo::Builder; | |||
use Plackdo::Middleware::XFramework; | |||
use Plackdo::App::URLMap; | |||
|
|||
my $app1 = sub (%env) { | |||
return ( | |||
200, | |||
[ | |||
Content-Type => 'text/plain', | |||
Content-Length => %env.perl.bytes, | |||
], | |||
[ %env.perl ] | |||
); | |||
}; | |||
|
|||
my $app2 = sub (%env) { | |||
my $b = " <html> <head><title>App 2!</title></head> <body> <h1>App 2</h1> <pre>{%env.perl}</pre> </body> </html> "; | |||
return ( | |||
200, | |||
[ | |||
Content-Type => 'text/html', | |||
Content-Length => $b.bytes, | |||
], | |||
[ $b ] | |||
); | |||
}; | |||
|
|||
my $builder = Plackdo::Builder.new; | |||
$builder.add_middleware( | |||
Plackdo::Middleware::XFramework.new(framework => 'foobar') | |||
); | |||
|
|||
my Plackdo::App::URLMap $urlmap .= new; | |||
$urlmap.mount('/plain', $builder.to_app($app1)); | |||
$urlmap.mount('/html', $app2); | |||
|
|||
$urlmap.to_app(); | |||
|
|||
# vim: ft=perl6 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Original file line | Diff line number | Diff line change |
---|---|---|---|
@@ -0,0 +1,77 @@ | |||
use v6; | |||
use Plackdo::Component; | |||
|
|||
class Plackdo::App::URLMap does Plackdo::Component { | |||
has @!mapping; | |||
has @!sorted_mapping; | |||
|
|||
method mount ($location, $app) { self.domap($location, $app) } | |||
|
|||
method domap ($location is copy, $app) { | |||
my $host; | |||
# TODO Use URI? | |||
if $location ~~ / ^ http s? '://' ( .*? ) ( '/' .* ) / { | |||
$host = $0; | |||
$location = $1; | |||
} | |||
|
|||
if ($location !~~ / ^ '/' /) { | |||
# Carp::croak? | |||
die("Paths need to start with /"); | |||
} | |||
$location ~~ s/\/$//; | |||
|
|||
push @!mapping, [ $host, $location, $app ]; | |||
} | |||
|
|||
method prepare_app { | |||
# Sort by length of host, then path; longest first | |||
@!sorted_mapping = @!mapping.sort({ | |||
($^b[0] // '').chars <=> ($^a[0] // '').chars | |||
|| | |||
$^b[1].chars <=> $^a[1].chars | |||
}); | |||
} | |||
|
|||
method call (%env) { | |||
my $path_info = %env<PATH_INFO>; | |||
my $script_name = %env<SCRIPT_NAME>; | |||
my $http_host = %env<HTTP_HOST>; | |||
my $server_name = %env<SERVER_NAME>; | |||
|
|||
if ($http_host and my $port = %env<SERVER_PORT>) { | |||
$http_host ~~ s/ \: $port $//; | |||
} | |||
|
|||
for @!sorted_mapping -> $map { | |||
my $host = $map[0]; | |||
my $location = $map[1]; | |||
my $app = $map[2]; | |||
my $path = $path_info; # Copy | |||
#note "Matching request (Host=$http_host Path=$path) and the map (Host=$host Path=$location)"; | |||
next if $host.defined and $host eq none($http_host, $server_name); | |||
# RAKUDO: $str ~~ s/ ^ Not Matching Regex // still returns Bool::True | |||
#next unless $location eq '' or $path ~~ s/ ^ $location //; | |||
next unless $location eq '' or $path ~~ / ^ $location /; $path ~~ s/ ^ $location //; | |||
next unless $path eq '' or $path ~~ m/ ^ \/ /; | |||
#note "-> Matched!"; | |||
|
|||
my $orig_path_info = %env<PATH_INFO>; | |||
my $orig_script_name = %env<SCRIPT_NAME>; | |||
|
|||
%env<PATH_INFO> = $path; | |||
%env<SCRIPT_NAME> = $script_name ~ $location; | |||
return self.response_cb($app(%env), sub ($res) { | |||
%env<PATH_INFO> = $orig_path_info; | |||
%env<SCRIPT_NAME> = $orig_script_name; | |||
return $res; | |||
}); | |||
} | |||
|
|||
#DEBUG && warn "All matching failed.\n"; | |||
|
|||
return [404, [ 'Content-Type' => 'text/plain' ], [ "Not Found" ]]; | |||
} | |||
} | |||
|
|||
# vim: ft=perl6 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Original file line | Diff line number | Diff line change |
---|---|---|---|
@@ -0,0 +1,55 @@ | |||
use v6; | |||
|
|||
use Test; | |||
plan 10; | |||
|
|||
use Plackdo::Test; | |||
use Plackdo::App::URLMap; | |||
|
|||
ok 1, 'Can load module'; | |||
|
|||
my Plackdo::App::URLMap $urlmap .= new; | |||
ok $urlmap, 'Can create URLMap instance'; | |||
|
|||
$urlmap.mount('http://example.com/foo', sub (%env) { return [ 200, [ Content-Type => 'text/plain' ], [ "PATH_INFO %env<PATH_INFO>" ] ] }); | |||
|
|||
$urlmap.mount('http://example.com/bar', sub (%env) { return [ 200, [ Content-Type => 'text/plain' ], [ "PATH_INFO %env<PATH_INFO> (with host)" ] ] }); | |||
|
|||
$urlmap.mount('/bar', sub (%env) { return [ 200, [ Content-Type => 'text/plain' ], [ "PATH_INFO %env<PATH_INFO>" ] ] }); | |||
|
|||
$urlmap.mount('/barbaz', sub (%env) { return [ 200, [ Content-Type => 'text/plain' ], [ "barbaz!" ] ] }); | |||
|
|||
test_p6sgi( | |||
$urlmap.to_app, | |||
sub (&cb) { | |||
my $res; | |||
|
|||
$res = &cb(new_request('GET', 'http://example.com/foo/testing')); | |||
is $res.content, 'PATH_INFO /testing', 'Matches host + path'; | |||
|
|||
$res = &cb(new_request('GET', 'http://perl6.org/foo/testing')); | |||
is $res.code, 404, 'Refuses to match a different hostname'; | |||
|
|||
$res = &cb(new_request('GET', 'http://nomatch.example.com/foo/testing')); | |||
is $res.code, 404, 'Refuses to match a subdomain'; | |||
|
|||
$res = &cb(new_request('GET', 'http://perl6.org/bar/testing')); | |||
is $res.content, 'PATH_INFO /testing', 'Matches path and Any host'; | |||
|
|||
$res = &cb(new_request('GET', 'https://example.com/bar/testing')); | |||
is $res.content, 'PATH_INFO /testing (with host)', 'Matches path and explicit host'; | |||
|
|||
$res = &cb(new_request('GET', '/bar/testing')); | |||
is $res.content, 'PATH_INFO /testing', 'Matches path only'; | |||
|
|||
$res = &cb(new_request('GET', '/bar')); | |||
is $res.content, 'PATH_INFO ', 'Empty PATH_INFO when no trailing slash'; | |||
|
|||
$res = &cb(new_request('GET', '/barbaz')); | |||
is $res.content, 'barbaz!', 'Longest path wins'; | |||
} | |||
); | |||
|
|||
done; | |||
|
|||
# vim: ft=perl6 : |