X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FWeb%2FSimple.pm;h=5e38ba8684b1c108ac3a4846b2597d77c9c949bd;hb=74afe4b70dc0f4b5f8de55fb4d17c4863d842c29;hp=7955c4655106e433f5edfb3fec4cf3811f0dad7e;hpb=81a5b03ea99065c6dfff6a3ccd99241dd03826c6;p=catagits%2FWeb-Simple.git diff --git a/lib/Web/Simple.pm b/lib/Web/Simple.pm index 7955c46..5e38ba8 100644 --- a/lib/Web/Simple.pm +++ b/lib/Web/Simple.pm @@ -3,14 +3,22 @@ package Web::Simple; 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); } @@ -20,22 +28,26 @@ sub _export_into { { no strict 'refs'; *{"${app_package}::dispatch"} = sub { - $app_package->_setup_dispatchables(@_); + $app_package->_setup_dispatcher(@_); }; - *{"${app_package}::filter_response"} = sub (&) { + *{"${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 { - my @defaults = @_; - *{"${app_package}::_default_config"} = sub { @defaults }; + $app_package->_setup_default_config(@_); }; *{"${app_package}::self"} = \${"${app_package}::self"}; require Web::Simple::Application; unshift(@{"${app_package}::ISA"}, 'Web::Simple::Application'); } + (my $name = $app_package) =~ s/::/\//g; + $INC{"${name}.pm"} = 'Set by "use Web::Simple;" invocation'; } =head1 NAME @@ -84,9 +96,11 @@ examples and non-CGI deployment, see below. =head1 WHY? -While I originally wrote Web::Simple as part of my Antiquated Perl talk for -Italian Perl Workshop 2009, I've found that having a bare minimum system for -writing web applications that doesn't drive me insane is rather nice. +Web::Simple was originally written to form part of my Antiquated Perl talk for +Italian Perl Workshop 2009, but in writing the bloggery example I realised +that having a bare minimum system for writing web applications that doesn't +drive me insane was rather nice and decided to spend my attempt at nanowrimo +for 2009 improving and documenting it to the point where others could use it. The philosophy of Web::Simple is to keep to an absolute bare minimum, for everything. It is not designed to be used for large scale applications; @@ -134,15 +148,27 @@ It also exports the following subroutines: dispatch [ sub (...) { ... }, ... ]; - filter_response { ... }; + response_filter { ... }; redispatch_to '/somewhere'; -and creates the $self global variable in your application package, so you can + 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'; + +so that perl will not attempt to load the application again even if + + require NameOfApplication; + +is encountered in other code. + =head1 EXPORTED SUBROUTINES =head2 default_config @@ -163,9 +189,8 @@ This creates the default configuration for the application, by creating a } 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 @@ -178,24 +203,30 @@ under Web::Simple will of course be fatal. } ]; -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 below for more details), and the body of the -subroutine is the code to execute if the specification matches. See -L below for details on how the Web::Simple dispatch +subroutine is the code to execute if the specification matches. + +Each dispatcher is given the dispatcher constructed from the next element +of the arrayref as its next dispatcher, except for the final element, 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 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_dispatchables creates a +Note that _setup_dispatcher creates a - sub _dispatchables { - return (); + sub _dispatcher { + return ; } 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 @@ -209,9 +240,47 @@ will result in a fatal warning from your application. 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 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. + +=head2 subdispatch + + subdispatch sub (/user/*/) { + my $u = $self->user($_[1]); + [ + sub (GET) { $u }, + sub (DELETE) { $u->delete }, + ] + } + +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. =head1 DISPATCH STRATEGY @@ -290,12 +359,178 @@ should unpack them like so: =head3 Method matches + sub (GET ...) { + +A match specification beginning with a capital letter matches HTTP requests +with that request method. + =head3 Path matches + sub (/login) { + +A match specification beginning with a / is a path match. In the simplest +case it matches a specific path. To match a path with a wildcard part, you +can do: + + sub (/user/*) { + $self->handle_user($_[1]) + +This will match /user/ where does not include a literal +/ character. The matched part becomes part of the match arguments. You can +also match more than one part: + + sub (/user/*/*) { + my ($self, $user_1, $user_2) = @_; + + sub (/domain/*/user/*) { + my ($self, $domain, $user) = @_; + +and so on. To match an arbitrary number of parts, use - + + sub (/page/**) { + +This will result in an element per /-separated part so matched. Note that +you can do + + sub (/page/**/edit) { + +to match an arbitrary number of parts up to but not including some final +part. + +Finally, + + sub (/foo/...) { + +will match /foo/ on the beginning of the path -and- strip it, much like +.html strips the extension. This is designed to be used to construct +nested dispatch structures, but can also prove useful for having e.g. an +optional language specification at the start of a path. + +Note that the '...' is a "maybe something here, maybe not" so the above +specification will match like this: + + /foo # no match + /foo/ # match and strip path to '/' + /foo/bar/baz # match and strip path to '/bar/baz' + =head3 Extension matches + sub (.html) { + +will match and strip .html from the path (assuming the subroutine itself +returns something, of course). This is normally used for rendering - e.g. + + sub (.html) { + response_filter { $self->render_html($_[1]) } + } + +Additionally, + + sub (.*) { + +will match any extension and supplies the stripped extension as a match +argument. + +=head3 Query and body parameter matches + +Query and body parameters can be match via + + sub (?) { # match URI query + sub (%) { # match body params + +The body is only matched if the content type is +application/x-www-form-urlencoded (note this means that Web::Simple does +not yet handle uploads; this will be addressed in a later release). + +The param spec is elements of one of the following forms - + + param~ # optional parameter + param= # required parameter + @param~ # optional multiple parameter + @param= # required multiple parameter + * # include all other parameters + @* # include all other parameters as multiple + +separated by the & character. + +So, to match a page parameter with an optional order_by parameter one +would write: + + sub (?page=&order_by~) { + +Parameters selected are turned into a hashref; in the case of singular +parameters then if multiple values are found the last one is used. In the +case of multiple parameters an arrayref of all values (or an empty arrayref +for a missing optional) is used. The resulting hashref is provided as a +match argument. So we might write something like: + + sub (?page=&order_by~) { + my ($self, $p) = @_; + return unless $p->{page} =~ /^\d+$/; + $p->{order_by} ||= 'id'; + response_filter { + $_[1]->search_rs({}, $p); + } + } + +to implement paging and ordering against a L object. + =head3 Combining matches +Matches may be combined with the + character - e.g. + + sub (GET + /user/*) { + +to create an AND match. They may also be combined withe the | character - e.g. + + sub (GET|POST) { + +to create an OR match. Matches can be nested with () - e.g. + + sub ((GET|POST) + /user/*) { + +and negated with ! - e.g. + + sub (!/user/foo + /user/*) { + +! binds to the immediate rightmost match specification, so if you want +to negate a combination you will need to use + + sub ( !(POST|PUT|DELETE) ) { + +and | binds tighter than +, so + + sub ((GET|POST) + /user/*) { + +and + + sub (GET|POST + /user/*) { + +are equivalent, but + + sub ((GET + .html) | (POST + .html)) { + +and + + sub (GET + .html | POST + .html) { + +are not - the latter is equivalent to + + sub (GET + (.html|POST) + .html) { + +which will never match. + +=head3 Whitespace + +Note that for legibility you are permitted to use whitespace - + + sub (GET + /user/*) { + +but it will be ignored. This is because the perl parser strips whitespace +from subroutine prototypes, so this is equivalent to + + sub (GET+/user/*) { + =cut 1;