package Web::Simple;
-use strict;
-use warnings FATAL => 'all';
+use strictures 1;
use 5.008;
+use warnings::illegalproto ();
-our $VERSION = '0.003';
-
-sub setup_all_strictures {
- strict->import;
- warnings->import(FATAL => 'all');
-}
-
-sub setup_dispatch_strictures {
- setup_all_strictures();
- warnings->unimport('syntax');
- warnings->import(FATAL => qw(
- ambiguous bareword digit parenthesis precedence printf
- prototype qw reserved semicolon
- ));
-}
+our $VERSION = '0.004';
sub import {
- setup_dispatch_strictures();
my ($class, $app_package) = @_;
- $class->_export_into($app_package);
+ $class->_export_into($app_package||caller);
+ eval "package $class; use Web::Dispatch::Wrapper; use Moo;";
+ strictures->import;
+ warnings::illegalproto->unimport;
}
sub _export_into {
my ($class, $app_package) = @_;
{
no strict 'refs';
- *{"${app_package}::dispatch"} = sub (&) {
- $app_package->_setup_dispatcher([ $_[0]->() ]);
- };
- *{"${app_package}::response_filter"} = sub (&) {
- $app_package->_construct_response_filter($_[0]);
- };
- *{"${app_package}::redispatch_to"} = sub {
- $app_package->_construct_redispatch($_[0]);
- };
- *{"${app_package}::subdispatch"} = sub ($) {
- $app_package->_construct_subdispatch($_[0]);
- };
- *{"${app_package}::default_config"} = sub {
- $app_package->_setup_default_config(@_);
- };
*{"${app_package}::PSGI_ENV"} = sub () { -1 };
- *{"${app_package}::self"} = \${"${app_package}::self"};
require Web::Simple::Application;
unshift(@{"${app_package}::ISA"}, 'Web::Simple::Application');
}
{
package HelloWorld;
- dispatch {
+ sub dispatch_request {
sub (GET) {
[ 200, [ 'Content-type', 'text/plain' ], [ 'Hello world!' ] ]
},
sub () {
[ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
}
- };
+ }
}
HelloWorld->run_if_script;
so far, considered a feature.
Calling the import also makes NameOfApplication isa Web::Simple::Application
-- i.e. does the equivalent of
+and sets your app class up as a L<Moo> class- i.e. does the equivalent of
{
package NameOfApplication;
- use base qw(Web::Simple::Application);
+ use Moo;
+ extends 'Web::Simple::Application';
}
-It also exports the following subroutines:
-
- default_config(
- key => 'value',
- ...
- );
-
- dispatch { sub (...) { ... }, ... };
+It also exports the following subroutines for use in dispatchers:
response_filter { ... };
redispatch_to '/somewhere';
- subdispatch sub (...) { ... }
-
-and creates a $self global variable in your application package, so you can
-use $self in dispatch subs without violating strict (Web::Simple::Application
-arranges for dispatch subroutines to have the correct $self in scope when
-this happens).
-
Finally, import sets
$INC{"NameOfApplication.pm"} = 'Set by "use Web::Simple;" invocation';
=head2 Examples
- dispatch {
+ sub dispatch_request {
# matches: GET /user/1.htm?show_details=1
# GET /user/1.htm
sub (GET + /user/* + ?show_details~ + .htm|.html|.xhtml) {
- shift; my ($user_id, $show_details) = @_;
+ my ($self, $user_id, $show_details) = @_;
...
},
# matches: POST /user?username=frew
# POST /user?username=mst&first_name=matt&last_name=trout
sub (POST + /user + ?username=&*) {
- shift; my ($username, $misc_params) = @_;
+ my ($self, $username, $misc_params) = @_;
...
},
# matches: DELETE /user/1/friend/2
sub (DELETE + /user/*/friend/*) {
- shift; my ($user_id, $friend_id) = @_;
+ my ($self, $user_id, $friend_id) = @_;
...
},
# matches: PUT /user/1?first_name=Matt&last_name=Trout
sub (PUT + /user/* + ?first_name~&last_name~) {
- shift; my ($user_id, $first_name, $last_name) = @_;
+ my ($self, $user_id, $first_name, $last_name) = @_;
...
},
sub (/user/*/...) {
- my $user_id = $_[1];
- subdispatch sub {
- [
- # matches: PUT /user/1/role/1
- sub (PUT + /role/*) {
- my $role_id = $_[1];
- ...
- },
- # matches: DELETE /user/1/role/1
- sub (DELETE + /role/*) {
- my $role_id = shift;
- ...
- },
- ];
- }
+ my $user_id = $_[1];
+ # matches: PUT /user/1/role/1
+ sub (PUT + /role/*) {
+ my $role_id = $_[1];
+ ...
+ },
+ # matches: DELETE /user/1/role/1
+ sub (DELETE + /role/*) {
+ my $role_id = $_[1];
+ ...
+ },
},
}
-=head2 Description of the dispatcher object
-
-Web::Simple::Dispatcher objects have three components:
-
-=over 4
-
-=item * match - an optional test if this dispatcher matches the request
-
-=item * call - a routine to call if this dispatcher matches (or has no match)
-
-=item * next - the next dispatcher to call
+=head2 The dispatch cycle
-=back
+At the beginning of a request, your app's dispatch_request method is called
+with the PSGI $env as an argument. You can handle the request entirely in
+here and return a PSGI response arrayref if you want:
-When a dispatcher is invoked, it checks its match routine against the
-request environment. The match routine may provide alterations to the
-request as a result of matching, and/or arguments for the call routine.
+ sub dispatch_request {
+ my ($self, $env) = @_;
+ [ 404, [ 'Content-type' => 'text/plain' ], [ 'Amnesia == fail' ] ]
+ }
-If no match routine has been provided then Web::Simple treats this as
-a success, and supplies the request environment to the call routine as
-an argument.
+However, generally, instead of that, you return a set of dispatch subs:
-Given a successful match, the call routine is now invoked in list context
-with any arguments given to the original dispatch, plus any arguments
-provided by the match result.
+ sub dispatch_request {
+ my $self = shift;
+ sub (/) { redispatch_to '/index.html' },
+ sub (/user/*) { $self->show_user($_[1]) },
+ ...
+ }
-If this routine returns (), Web::Simple treats this identically to a failure
-to match.
+If you return a subroutine with a prototype, the prototype is treated
+as a match specification - and if the test is passed, the body of the
+sub is called as a method any matched arguments (see below for more details).
-If this routine returns a Web::Simple::Dispatcher, the environment changes
-are merged into the environment and the new dispatcher's next pointer is
-set to our next pointer.
+You can also return a plain subroutine which will be called with just $env
+- remember that in this case if you need $self you -must- close over it.
-If this routine returns anything else, that is treated as the end of dispatch
-and the value is returned.
+If you return a normal object, Web::Simple will simply return it upwards on
+the assumption that a response_filter somewhere will convert it to something
+useful - this allows:
-On a failed match, Web::Simple invokes the next dispatcher with the same
-arguments and request environment passed to the current one. On a successful
-match that returned a new dispatcher, Web::Simple invokes the new dispatcher
-with the same arguments but the modified request environment.
+ sub dispatch_request {
+ my $self = shift;
+ sub (.html) { response_filter { $self->render_zoom($_[0]) } },
+ sub (/user/*) { $self->users->get($_[1]) },
+ }
-=head2 How Web::Simple builds dispatcher objects for you
+to render a user object to HTML, for example.
-In the case of the Web::Simple L</dispatch> export the match is constructed
-from the subroutine prototype - i.e.
+However, two types of object are treated specially - a Plack::App object
+will have its ->to_app method called and be used as a dispatcher:
- sub (<match specification>) {
- <call code>
+ sub dispatch_request {
+ my $self = shift;
+ sub (/static/...) { Plack::App::File->new(...) },
+ ...
}
-and the 'next' pointer is populated with the next element of the array,
-expect for the last element, which is given a next that will throw a 500
-error if none of your dispatchers match. If you want to provide something
-else as a default, a routine with no match specification always matches, so -
+A Plack::Middleware object will be used as a filter for the rest of the
+dispatch being returned into:
- sub () {
- [ 404, [ 'Content-type', 'text/plain' ], [ 'Error: Not Found' ] ]
+ sub dispatch_request {
+ my $self = shift;
+ ...
+ sub (/admin) { Plack::Middleware::Session->new(...) },
+ ... # dispatchers needing a session go here
}
-will produce a 404 result instead of a 500 by default. You can also override
-the L<Web::Simple::Application/_build_final_dispatcher> method in your app.
+Note that this is for the dispatch being -returned- to, so if you want to
+provide it inline you need to do:
-Note that the code in the subroutine is executed as a -method- on your
-application object, so if your match specification provides arguments you
-should unpack them like so:
-
- sub (<match specification>) {
- my ($self, @args) = @_;
+ sub dispatch_request {
+ my $self = shift;
...
+ sub (/admin/...) {
+ sub { Plack::Middleware::Session->new(...) },
+ ... # dispatchers under /admin
+ }
}
+And that's it - but remember that all this happens recursively - it's
+dispatchers all the way down.
+
=head2 Web::Simple match specifications
=head3 Method matches
=head3 Accessing the PSGI env hash
-To gain the benefit of using some middleware, specifically
-Plack::Middleware::Session access to the ENV hash is needed. This is provided
-in arguments to the dispatched handler. You can access this hash with the
-exported +PSGI_ENV constant.
-
- sub (GET + /foo + ?some_param=) {
- my($self, $some_param, $env) = @_[0, 1, +PSGI_ENV];
-
-=head1 EXPORTED SUBROUTINES
-
-=head2 default_config
-
- default_config(
- one_key => 'foo',
- another_key => 'bar',
- );
-
- ...
-
- $self->config->{one_key} # 'foo'
+In some cases you may wish to get the raw PSGI env hash - to do this,
+you can either use a plain sub -
-This creates the default configuration for the application, by creating a
-
- sub _default_config {
- return (one_key => 'foo', another_key => 'bar');
+ sub {
+ my ($env) = @_;
+ ...
}
-in the application namespace when executed. Note that this means that
-you should only run default_config once - calling it a second time will
-cause an exception to be thrown.
-
-=head2 dispatch
-
- dispatch {
- sub (GET) {
- [ 200, [ 'Content-type', 'text/plain' ], [ 'Hello world!' ] ]
- },
- sub () {
- [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
- }
- };
-
-The dispatch subroutine calls NameOfApplication->_setup_dispatcher with
-the return value of the block passed to it, which then creates your Web::Simple
-application's dispatcher from these subs. The prototype of each subroutine
-is expected to be a Web::Simple dispatch specification (see
-L</DISPATCH SPECIFICATIONS> below for more details), and the body of the
-subroutine is the code to execute if the specification matches.
-
-Each dispatcher is given the dispatcher constructed from the next subroutine
-returned as its next dispatcher, except for the final subroutine, which
-is given the return value of NameOfApplication->_build_final_dispatcher
-as its next dispatcher (by default this returns a 500 error response).
-
-See L</DISPATCH STRATEGY> below for details on how the Web::Simple dispatch
-system uses the return values of these subroutines to determine how to
-continue, alter or abort dispatch.
+or use the PSGI_ENV constant exported to retrieve it:
-Note that _setup_dispatcher creates a
-
- sub _dispatcher {
- return <root dispatcher object here>;
+ sub (GET + /foo + ?some_param=) {
+ my $param = $_[1];
+ my $env = $_[PSGI_ENV];
}
-method in your class so as with default_config, calling dispatch a second time
-will result in an exception.
+but note that if you're trying to add a middleware, you should simply use
+Web::Simple's direct support for doing so.
+
+=head1 EXPORTED SUBROUTINES
=head2 response_filter
response_filter {
# Hide errors from the user because we hates them, preciousss
- if (ref($_[1]) eq 'ARRAY' && $_[1]->[0] == 500) {
- $_[1] = [ 200, @{$_[1]}[1..$#{$_[1]}] ];
+ if (ref($_[0]) eq 'ARRAY' && $_[0]->[0] == 500) {
+ $_[0] = [ 200, @{$_[0]}[1..$#{$_[0]}] ];
}
- return $_[1];
+ return $_[0];
};
The response_filter subroutine is designed for use inside dispatch subroutines.
of continuing dispatch re-delegates it to the start of the dispatch process,
but with the path of the request altered to the supplied URL.
-Thus if you receive a POST to '/some/url' and return a redipstch to
+Thus if you receive a POST to '/some/url' and return a redispatch to
'/other/url', the dispatch behaviour will be exactly as if the same POST
request had been made to '/other/url' instead.
-=head2 subdispatch
+=head1 CHANGES BETWEEN RELEASES
+
+=head2 Changes between 0.004 and 0.005
+
+=over 4
+
+=item * dispatch {} replaced by declaring a dispatch_request method
- subdispatch sub (/user/*/) {
- my $u = $self->user($_[1]);
+dispatch {} has gone away - instead, you write:
+
+ sub dispatch_request {
+ my $self = shift;
+ sub (GET /foo/) { ... },
+ ...
+ }
+
+Note that this method is still -returning- the dispatch code - just like
+dispatch did.
+
+Also note that you need the 'my $self = shift' since the magic $self
+variable went away.
+
+=item * the magic $self variable went away.
+
+Just add 'my $self = shift;' while writing your 'sub dispatch_request {'
+like a normal perl method.
+
+=item * subdispatch deleted - all dispatchers can now subdispatch
+
+In earlier releases you needed to write:
+
+ subdispatch sub (/foo/...) {
+ ...
[
- sub (GET) { $u },
- sub (DELETE) { $u->delete },
+ sub (GET /bar/) { ... },
+ ...
]
}
-The subdispatch subroutine is designed for use in dispatcher construction.
-
-It creates a dispatcher which, if it matches, treats its return value not
-as a final value but an arrayref of dispatch specifications such as could
-be passed to the dispatch subroutine itself. These are turned into a dispatcher
-which is then invoked. Any changes the match makes to the request are in
-scope for this inner dispatcher only - so if the initial match is a
-destructive one like .html the full path will be restored if the
-subdispatch fails.
+As of 0.005, you can instead write simply:
-=head1 CHANGES BETWEEN RELEASES
+ sub (/foo/...) {
+ ...
+ (
+ sub (GET /bar/) { ... },
+ ...
+ )
+ }
=head2 Changes since Antiquated Perl
projects / catagits/Web-Simple.git / blobdiff