Permalink
Browse files

Implemented Piglet::Decorator, Piglet::PSGI::App and Request/Response…

… classes.
  • Loading branch information...
1 parent 47b9e02 commit bb755b35a9e499461956cd0b651c0a6a50230653 @miyagawa committed Mar 24, 2010
Showing with 274 additions and 2 deletions.
  1. +1 −0 Makefile.PL
  2. +4 −2 README
  3. +104 −0 lib/Piglet/Decorator.pm
  4. +69 −0 lib/Piglet/PSGI/App.pm
  5. +13 −0 lib/Piglet/Request.pm
  6. +11 −0 lib/Piglet/Response.pm
  7. +1 −0 lib/Piglet/Routes.pm
  8. +71 −0 t/decorator/app.t
View
@@ -5,6 +5,7 @@ requires 'Plack', 0.99;
requires 'Router::Simple', 0.03;
requires 'Data::Section::Simple';
requires 'Sub::Exporter';
+requires 'parent';
build_requires 'Test::More', 0.88;
tests_recursive;
test_requires 'Test::Requires';
View
6 README
@@ -63,8 +63,10 @@ MOTIVATIONS
Because it's built on top of PSGI, it's easy to later migrate or upgrade
to more featureful *real web frameworks* such as Catalyst or Jifty.
- Read more about the idea of framework-less WSGI web application on <Ian
- Bicking's blog post> which is an inspiration for this project.
+ Read more about the idea of framework-less WSGI web application on Ian
+ Bicking's blog post
+ <http://blog.ianbicking.org/2010/03/12/a-webob-app-example/> which is an
+ inspiration for this project.
AUTHOR
Tatsuhiko Miyagawa
View
@@ -0,0 +1,104 @@
+package Piglet::Decorator;
+use strict;
+use warnings;
+
+use Scalar::Util qw(blessed);
+use Piglet::Request;
+use Try::Tiny;
+use Plack::Middleware::HTTPExceptions;
+
+sub psgify {
+ my($self, $app) = @_;
+
+ if (blessed($app) && $app->isa('Piglet::PSGI::App')) {
+ return $app;
+ }
+
+ my $wrapped = sub {
+ my $env = shift;
+ my $req = Piglet::Request->new($env);
+
+ my $res = try {
+ $app->($req);
+ } catch {
+ $env->{'piglet.exception.caught'} = $_;
+ return $_;
+ };
+
+ $self->psgi_response($res, $req, $env);
+ };
+
+ Plack::Middleware::HTTPExceptions->wrap($wrapped);
+}
+
+sub psgi_response {
+ my($self, $res, $req, $env) = @_;
+
+ if (blessed($res) && $res->isa('Piglet::PSGI::App')) {
+ return $res->($env);
+ } elsif (ref $res eq 'ARRAY' or ref $res eq 'CODE') {
+ return $res;
+ } elsif ($env->{'piglet.exception.caught'}) {
+ die $res;
+ } elsif (!ref $res) {
+ my $body = $res;
+ $res = $req->new_response(200);
+ $res->content_type('text/html');
+ $res->content_length(length $body);
+ $res->content($body);
+ return $res->finalize;
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Piglet::Decorator - Turns subs into PSGI application
+
+=head1 SYNOPSIS
+
+ my $app = Piglet::Decorator->psgify($sub);
+
+ # $sub can be ...
+
+ # returns a string
+ sub {
+ my $req = shift; # Piglet::Request
+ return "Hello World";
+ };
+
+ # returns a PSGI response array ref
+ sub { [ 200, [ "Content-Type" => 'text/plain' ], [ "Hello" ] ] };
+
+ # returns a PSGI streaming response
+ sub {
+ my $req = shift;
+ return sub {
+ my $respond = shift;
+ $respond->([ 200, [...], [...] ]);
+ };
+ };
+
+ # returns a new PSGI application
+ sub {
+ my $req = shift;
+ return Piglet::PSGI::App->new(sub {
+ my $env = shift;
+ return [ 200, [...], [...] ];
+ });
+ };
+
+ # returns Piglet::Response
+ sub {
+ my $req = shift;
+ my $res = $req->new_response(200);
+ $res->content("Hello");
+ $res;
+ }
+
+ # throws an exception that has ->code and optionally ->message
+ sub { HTTP::Exception::NOT_FOUND->throw }
+
View
@@ -0,0 +1,69 @@
+package Piglet::PSGI::App;
+use strict;
+use Carp ();
+
+sub new { bless $_[1], $_[0] }
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ if ($args{'-app'}) {
+ my $app = $args{'-app'};
+ my $pkg = caller(0);
+ my $code = join "\n",
+ "package $pkg;",
+ "use overload '&{}' => sub { \$_[0]->$app }, fallback => 1;",
+ "sub isa {",
+ " return 1 if \$_[1] eq 'Piglet::PSGI::App';",
+ " shift->SUPER::isa(\@_);",
+ "}";
+
+ eval $code;
+ Carp::croak( "Failed to create isa method: $@" ) if $@;
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Piglet::PSGI::App - Marker class to bless a code reference as a PSGI application
+
+=head1 SYNOPSIS
+
+ my $app = Piglet::PSGI::App->new(sub {
+ my $env = shift;
+ return [ 200, [ ... ], [ ... ] ];
+ });
+
+ # Or in your class
+ package MyApplication::Class;
+ use Plack::PSGI::App -app => 'as_psgi_app';
+
+ sub as_psgi_app {
+ my $self = shift;
+ return sub {
+ my $env = shift;
+ ...
+ }
+ }
+
+=head1 DESCRIPTION
+
+This class is an empty class to bless PSGI subs into, to indicate that
+the given code reference is a PSGI application.
+
+Or you can C<use> this module as a mixin in your class to override
+C<isa> to return true on C<< ->isa("Plack::PSGI::App") >> and then
+overload the C<&{}> to return PSGI application code reference.
+
+=head1 SEE ALSO
+
+L<Piglet>
+
+=cut
+
+
View
@@ -0,0 +1,13 @@
+package Piglet::Request;
+use strict;
+use parent qw(Plack::Request);
+
+use Piglet::Response;
+
+sub new_response {
+ my $self = shift;
+ Piglet::Response->new(@_);
+}
+
+1;
+
View
@@ -0,0 +1,11 @@
+package Piglet::Response;
+use parent qw(Plack::Response);
+
+use Piglet::PSGI::App -app => 'as_psgi_app';
+
+sub as_psgi_app {
+ my $self = shift;
+ sub { $self->finalize };
+}
+
+1;
View
@@ -1,5 +1,6 @@
package Piglet::Routes;
use strict;
+use warnings;
use Carp ();
use Encode ();
use Router::Simple;
View
@@ -0,0 +1,71 @@
+use strict;
+use Test::More;
+use Piglet::Decorator;
+use Plack::Test;
+use HTTP::Request::Common;
+
+sub MyHTTPException::throw { die(bless [ $_[1] ], $_[0]) }
+sub MyHTTPException::code { $_[0]->[0] }
+
+my @app = (
+ # return a string
+ sub {
+ my $req = shift;
+ return "Hello World";
+ },
+ sub {
+ is $_[0]->content_type, 'text/html';
+ is $_[0]->content_length, 11;
+ is $_[0]->content, "Hello World";
+ },
+ # Piglet::Response
+ sub {
+ my $req = shift;
+ my $res = $req->new_response(200);
+ $res->content("Hello " . ref $req);
+ },
+ sub {
+ is $_[0]->content, "Hello Piglet::Request";
+ },
+ # new PSGI application
+ sub {
+ return Piglet::PSGI::App->new(sub {
+ my $env = shift;
+ [ 200, [ "Content-Type", "text/plain" ], [ "Hello PSGI App" ] ];
+ });
+ },
+ sub {
+ is $_[0]->content_type, 'text/plain';
+ is $_[0]->content, "Hello PSGI App";
+ },
+ # PSGI streaming app
+ sub {
+ return sub {
+ $_[0]->([ 200, [ "Content-Type", "text/plain" ], [ "Streaming App" ] ]);
+ };
+ },
+ sub {
+ is $_[0]->content_type, 'text/plain';
+ is $_[0]->content, "Streaming App";
+ },
+ # throws an exception
+ sub {
+ MyHTTPException->throw(403);
+ },
+ sub {
+ is $_[0]->code, 403;
+ is $_[0]->content, 'Forbidden';
+ },
+);
+
+while (@app) {
+ my($app, $test) = splice @app, 0, 2;
+ $app = Piglet::Decorator->psgify($app);
+ test_psgi $app, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/");
+ $test->($res);
+ };
+}
+
+done_testing;

0 comments on commit bb755b3

Please sign in to comment.