package Web::Simple;
-use strict;
-use warnings FATAL => 'all';
+use strictures 1;
use 5.008;
+use warnings::illegalproto ();
-our $VERSION = '0.001';
-
-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}::self"} = \${"${app_package}::self"};
+ *{"${app_package}::PSGI_ENV"} = sub () { -1 };
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
+=head2
+Description of the dispatcher object
Web::Simple::Dispatcher objects have three components:
sub (GET+/user/*) {
-=head1 EXPORTED SUBROUTINES
-
-=head2 default_config
+=head3 Accessing the PSGI env hash
- default_config(
- one_key => 'foo',
- another_key => 'bar',
- );
+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];
- $self->config->{one_key} # 'foo'
+=head2 Dispatcher return values
-This creates the default configuration for the application, by creating a
-
- sub _default_config {
- return (one_key => 'foo', another_key => 'bar');
- }
-
-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.
-
-Note that _setup_dispatcher creates a
-
- sub _dispatcher {
- return <root dispatcher object here>;
- }
+A dispatcher returns one of:
-method in your class so as with default_config, calling dispatch a second time
-will result in an exception.
+=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.
=head1 CHANGES BETWEEN RELEASES
+=head2 Changes between 0.004 and 0.005
+
+=over 4
+
+=item * dispatch {} replaced by declaring a dispatch_request method
+
+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 /bar/) { ... },
+ ...
+ ]
+ }
+
+As of 0.005, you can instead write simply:
+
+ sub (/foo/...) {
+ ...
+ (
+ sub (GET /bar/) { ... },
+ ...
+ )
+ }
+
=head2 Changes since Antiquated Perl
=over 4
projects / catagits/Web-Simple.git / blobdiff