Permalink
Browse files

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...
1 parent 12a2ed8 commit f79d08628759aabb835dc15044d43c51297688d8 @softmoth softmoth committed Jul 16, 2011
Showing with 172 additions and 0 deletions.
  1. +40 −0 eg/urlmap.p6sgi
  2. +77 −0 lib/Plackdo/App/URLMap.pm
  3. +55 −0 t/Plackdo-App/urlmap.t
View
@@ -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
View
@@ -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
View
@@ -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 :

0 comments on commit f79d086

Please sign in to comment.