Permalink
Browse files

想定する構成に

  • Loading branch information...
cho45 committed May 17, 2009
1 parent 76039b1 commit bf652f682e9669271aab849d41da48edd71d3500
Showing with 210 additions and 108 deletions.
  1. +45 −0 examples/Foo/lib/Foo/App.pm
  2. +17 −0 examples/Foo/lib/Foo/App/User.pm
  3. +84 −0 examples/Foo/lib/Foo/Router.pm
  4. +39 −0 examples/Foo/lib/Foo/View.pm
  5. +17 −19 lib/Chord/Router/HTTP.pm
  6. +8 −89 sketch.pl
@@ -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;
@@ -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;
@@ -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;
@@ -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__
+
+
+
View
@@ -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 {
View
@@ -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;

0 comments on commit bf652f6

Please sign in to comment.