想定する構成に

cho45 · May 17, 2009 · bf652f6 · bf652f6
1 parent 76039b1
commit bf652f6
Show file tree

Hide file tree

Showing 6 changed files with 210 additions and 108 deletions.
diff --git a/examples/Foo/lib/Foo/App.pm b/examples/Foo/lib/Foo/App.pm
@@ -0,0 +1,45 @@
+package Foo::App;
+use Any::Moose;
+
+use Exporter::Lite;
+our @EXPORT = qw/app throw/;
+
+use Exception::Class (
+	"Foo::App::Exception",
+	"Foo::App::UserRequired"   => { isa => "Foo::App::Exception" },
+	"Foo::App::AuthorNotFound" => { isa => "Foo::App::Exception" }
+);
+
+has author_name => (
+	is => 'rw',
+	isa => 'Str'
+);
+
+has author => (
+	is => 'rw',
+	isa => 'Any' ## Model::User
+);
+
+sub app {
+	my ($name) = @_;
+	return __PACKAGE__ unless $name;
+	my $ret = sprintf("%s::%s", __PACKAGE__, $name);
+	$ret->use or die $@;
+	$ret;
+}
+
+sub throw {
+	my ($name, $error) = @_;
+	my $exception = sprintf("%s::%s", __PACKAGE__, $name);
+	$exception->throw(error => $error);
+}
+
+sub user {
+	my ($class, %opts) = @_;
+	# XXX retrieve user with opts ...
+	{
+		name => "cho45"
+	};
+}
+
+1;
diff --git a/examples/Foo/lib/Foo/App/User.pm b/examples/Foo/lib/Foo/App/User.pm
@@ -0,0 +1,17 @@
+package Foo::App::User;
+use Any::Moose;
+
+use Foo::App;
+
+extends app;
+
+
+sub message {
+	my ($self) = @_;
+
+	throw("AuthorNotFound", { author => $self->author_name }) unless $self->author_name eq 'foo';
+
+	sprintf("This is %s's page.", $self->author_name);
+}
+
+1;
diff --git a/examples/Foo/lib/Foo/Router.pm b/examples/Foo/lib/Foo/Router.pm
@@ -0,0 +1,84 @@
+package Foo::Router;
+use Any::Moose;
+
+use Chord::Router::HTTP;
+extends "Chord::Router::HTTP";
+
+use Foo::App;
+use Foo::View;
+
+use Data::Dumper;
+sub p ($) { warn Dumper shift };
+
+# filter
+
+around "process" => sub {
+	my ($next, $class, @args) = @_;
+
+	my ($request) = @args;
+	$request->param(
+		user => app->user(session_id => $request->cookie('session_id'))
+	);
+
+	$next->($class, @args);
+};
+
+around "dispatch" => sub {
+	my ($next, $class, @args) = @_;
+
+	my ($req, $res) = @args;
+	eval {
+		$res = $next->($class, @args);
+	};
+	if (my $e = Exception::Class->caught('Foo::App::AuthorNotFound') ) {
+		$res->code(404);
+		$res->content(sprintf("%s is not found.", $e->error->{author}));
+	}
+	$res;
+};
+
+# routing
+
+route "/",
+	action => sub {
+		my ($req, $res) = @_;
+		html $res, {
+			title   => "Hello",
+			content => "Hello",
+		};
+	};
+
+route "/my/*path",
+	action => sub {
+		my ($req, $res) = @_;
+		$res->code(302);
+		$res->header("Location" => sprintf("/foo/%s", $req->param("path")));
+	};
+
+route "/:author/", author => qr/[a-z][a-z0-9]{1,30}/,
+	action => sub {
+		my ($req, $res) = @_;
+		my $app = app("User")->new(
+			author_name => $req->param("author")
+		);
+
+		html $res, {
+			title   => "Hello",
+			content => $app->message
+		};
+	};
+
+route "/api/foo",
+	action => sub {
+		my ($req, $res) = @_;
+		json $res, {
+			foo => "bar"
+		};
+	};
+
+route "/die",
+	action => sub {
+		die "Died";
+	};
+
+1;
diff --git a/examples/Foo/lib/Foo/View.pm b/examples/Foo/lib/Foo/View.pm
@@ -0,0 +1,39 @@
+package Foo::View;
+
+use strict;
+use warnings;
+
+use Exporter::Lite;
+our @EXPORT = qw/json html/;
+
+# define views
+use JSON::XS;
+sub json ($$) {
+	my ($res, $stash) = @_;
+	$res->header("Content-Type" => "application/json");
+	$res->content(encode_json($stash));
+}
+
+use Text::MicroMason;
+use Text::MicroMason::AllowGlobals;
+sub html ($%) {
+	my ($res, $stash) = @_;
+	my $m  = Text::MicroMason->new(qw/ -SafeServerPages -AllowGlobals /);
+	$m->set_globals(map { ("\$$_", $stash->{$_}) } keys %$stash);
+
+	my $content = $m->execute(text =>  q{
+		<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
+		<title><%= $title %></title>
+		<p><%= $content %>
+	});
+
+	$res->header("Content-Type" => "text/html");
+	$res->content($content);
+}
+
+
+1;
+__END__
+
+
+
diff --git a/lib/Chord/Router/HTTP.pm b/lib/Chord/Router/HTTP.pm
@@ -31,8 +31,8 @@ sub route ($;%) {
 }
 
 sub dispatch {
-	my ($self, $request, @opts) = @_;
-	my $path   = $request->path;
+	my ($self, $req, $res, @opts) = @_;
+	my $path   = $req->path;
 	my $params = {};
 	my $action;
 
@@ -46,29 +46,27 @@ sub dispatch {
 		}
 	}
 
-	my $req = $request;
 	$req->param(%$params);
+	$action ? $action->($req, $res, @opts) : undef;
+}
+
+sub process {
+	my ($self, $req, @opts) = @_;
+
 	my $res = HTTP::Engine::Response->new(status => 200);
 	$res->header("Content-Type" => "text/html");
-	if ($action) {
-		eval {
-			$action->($req, $res, @opts);
-		}; if ($@) {
-			$res->code(500);
-			$res->header("Content-Type" => "text/plain");
-			$res->content($@);
+	eval {
+		unless ($self->dispatch($req, $res, @opts)) {
+			$res->code(404);
+			$res->content("Not Found");
 		}
-	} else {
-		$res->code(404);
-		$res->content("Not Found");
+	}; if ($@) {
+		$res->code(500);
+		$res->header("Content-Type" => "text/plain");
+		$res->content($@);
 	}
-	$res;
-}
-
-sub process {
-	my ($self, $request, @opts) = @_;
 
-	$self->dispatch($request, @opts);
+	$res;
 }
 
 sub run {

diff --git a/sketch.pl b/sketch.pl
@@ -1,95 +1,14 @@
 #!/usr/bin/env perl
-package FooRouter;
-use Any::Moose;
 
-use Chord::Router::HTTP;
-extends "Chord::Router::HTTP";
+use strict;
+use warnings;
 
-use Data::Dumper;
-sub p ($) { warn Dumper shift };
+use lib 'lib';
+use lib glob 'examples/*/lib';
 
-# define views
-use JSON::XS;
-sub json ($$) {
-	my ($res, $stash) = @_;
-	$res->header("Content-Type" => "application/json");
-	$res->content(encode_json($stash));
-}
+require UNIVERSAL::require;
 
-use Text::MicroMason;
-sub html ($%) {
-	my ($res, $stash) = @_;
-	my $m  = Text::MicroMason->new(qw/ -SafeServerPages -AllowGlobals /);
-	$m->set_globals(map { ("\$$_", $stash->{$_}) } keys %$stash);
-
-	my $content = $m->execute(text =>  q{
-		<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
-		<title><%= $title %></title>
-		<p><%= $content %>
-	});
-
-	$res->header("Content-Type" => "text/html");
-	$res->content($content);
-}
-
-# filter
-
-around "process" => sub {
-	my ($next, $class, @args) = @_;
-
-	my ($request) = @args;
-	$request->param(
-		user => $request->cookie('session_id')
-	);
-
-	$next->($class, @args);
-};
-
-# routing
-
-route "/",
-	action => sub {
-		my ($req, $res) = @_;
-		html $res, {
-			title   => "Hello",
-			content => "Hello",
-		};
-	};
-
-route "/my/*path",
-	action => sub {
-		my ($req, $res) = @_;
-		$res->code(302);
-		$res->header("Location" => sprintf("/foo/%s", $req->param("path")));
-	};
-
-route "/:author/", author => qr/[a-z][a-z0-9]{1,30}/,
-	action => sub {
-		my ($req, $res) = @_;
-		html $res, {
-			title   => "Hello",
-			content => sprintf("This is %s's page.", $req->param("author"))
-		};
-	};
-
-route "/api/foo",
-	action => sub {
-		my ($req, $res) = @_;
-		json $res, {
-			foo => "bar"
-		};
-	};
-
-route "/die",
-	action => sub {
-		die "Died";
-	};
-
-
-__PACKAGE__->run;
-
-__END__
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
-<title><%= title %></title>
-<p><%= content %>
+my $router = 'Foo::Router';
+$router->use or die $@;
+$router->run;