use strict;
use warnings FATAL => 'all';
-sub import {
+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
));
+}
+
+sub import {
+ setup_dispatch_strictures();
my ($class, $app_package) = @_;
$class->_export_into($app_package);
}
{
no strict 'refs';
*{"${app_package}::dispatch"} = sub {
- $app_package->_setup_dispatchables(@_);
+ $app_package->_setup_dispatcher(@_);
};
*{"${app_package}::filter_response"} = sub (&) {
$app_package->_construct_response_filter($_[0]);
$app_package->_construct_redispatch($_[0]);
};
*{"${app_package}::default_config"} = sub {
- my @defaults = @_;
- *{"${app_package}::_default_config"} = sub { @defaults };
+ $app_package->_setup_default_config(@_);
};
*{"${app_package}::self"} = \${"${app_package}::self"};
require Web::Simple::Application;
redispatch_to '/somewhere';
-and creates the $self global variable in your application package, so you can
+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).
}
in the application namespace when executed. Note that this means that
-you should only run default_config once - a second run will cause a warning
-that you are override the _default_config method in your application, which
-under Web::Simple will of course be fatal.
+you should only run default_config once - calling it a second time will
+cause an exception to be thrown.
=head2 dispatch
}
];
-The dispatch subroutine calls NameOfApplication->_setup_dispatchables with
-the subroutines passed to it, which then create's your Web::Simple
+The dispatch subroutine calls NameOfApplication->_setup_dispatcher with
+the subroutines passed to it, which then creates your Web::Simple
application's dispatcher from these subs. The prototype of the subroutine
is expected to be a Web::Simple dispatch specification (see
L</DISPATCH SPECIFICATIONS> below for more details), and the body of the
system uses the return values of these subroutines to determine how to
continue, alter or abort dispatch.
-Note that _setup_dispatchables creates a
+Note that _setup_dispatcher creates a
- sub _dispatchables {
- return (<dispatchable objects here>);
+ sub _dispatcher {
+ return <root dispatcher object here>;
}
method in your class so as with default_config, calling dispatch a second time
-will result in a fatal warning from your application.
+will result in an exception.
=head2 response_filter
The response_filter subroutine is designed for use inside dispatch subroutines.
-It creates and returns a response filter object to the dispatcher,
-encapsulating the block passed to it as the filter routine to call. See
-L</DISPATCH STRATEGY> below for how a response filter affects dispatch.
+It creates and returns a special dispatcher that always matches, and calls
+the block passed to it as a filter on the result of running the rest of the
+current dispatch chain.
+
+Thus the filter above runs further dispatch as normal, but if the result of
+dispatch is a 500 (Internal Server Error) response, changes this to a 200 (OK)
+response without altering the headers or body.
+
+=head2 redispatch_to
+
+ redispatch_to '/other/url';
+
+The redispatch_to subroutine is designed for use inside dispatch subroutines.
+
+It creates and returns a special dispatcher that always matches, and instead
+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
+'/other/url', the dispatch behaviour will be exactly as if the same POST
+request had been made to '/other/url' instead.
=head1 DISPATCH STRATEGY
Note that for legibility you are permitted to use whitespace -
- sub(GET + /user/*) {
+ sub (GET + /user/*) {
but it will be ignored.
bless({ config => $config }, $class);
}
+sub _setup_default_config {
+ my $class = shift;
+ {
+ no strict 'refs';
+ if (${"${class}::_default_config"}{CODE}) {
+ $class->_cannot_call_twice('_setup_default_config', 'default_config');
+ }
+ }
+ my @defaults = (@_, $class->_default_config);
+ {
+ no strict 'refs';
+ *{"${class}::_default_config"} = sub { @defaults };
+ }
+}
+
sub _default_config { () }
sub config {
call => sub {
shift;
my ($self, $env) = @_;
- $self->handle_request({ %{$env}, PATH_INFO => $new_path })
+ $self->_dispatch({ %{$env}, PATH_INFO => $new_path })
}
})
}
-sub _dispatch_parser {
+sub _build_dispatch_parser {
require Web::Simple::DispatchParser;
return Web::Simple::DispatchParser->new;
}
-sub _setup_dispatchables {
+sub _cannot_call_twice {
+ my ($class, $method, $sub) = @_;
+ my $error = "Cannot call ${method} twice for ${class}";
+ if ($sub) {
+ $error .= " - did you call Web::Simple's ${sub} export twice?";
+ }
+ die $error;
+}
+
+sub _setup_dispatcher {
my ($class, $dispatch_subs) = @_;
- my $parser = $class->_dispatch_parser;
- my @dispatchables;
+ {
+ no strict 'refs';
+ if (${"${class}::_dispatcher"}{CODE}) {
+ $class->_cannot_call_twice('_setup_dispatcher', 'dispatch');
+ }
+ }
+ my $parser = $class->_build_dispatch_parser;
my ($root, $last);
foreach my $dispatch_sub (@$dispatch_subs) {
my $proto = prototype $dispatch_sub;
});
$root ||= $new;
$last = $last ? $last->next($new) : $new;
- push @dispatchables, [ $matcher, $dispatch_sub ];
}
$last->next($class->_build_final_dispatcher);
{
no strict 'refs';
- *{"${class}::_dispatch_root"} = sub { $root };
+ *{"${class}::_dispatcher"} = sub { $root };
}
}
})
}
-sub handle_request {
+sub _dispatch {
my ($self, $env) = @_;
- $self->_dispatch_root->dispatch($env, $self);
+ $self->_dispatcher->dispatch($env, $self);
}
sub _run_with_self {
sub _run_cgi {
my $self = shift;
require Web::Simple::HackedPlack;
- Plack::Server::CGI->run(sub { $self->handle_request(@_) });
+ Plack::Server::CGI->run(sub { $self->_dispatch(@_) });
}
sub run {
projects / catagits/Web-Simple.git / commitdiff