5 use warnings::illegalproto ();
7 use Web::Dispatch::Wrapper ();
9 our $VERSION = '0.004';
12 my ($class, $app_package) = @_;
13 $app_package ||= caller;
14 $class->_export_into($app_package);
15 eval "package $app_package; use Web::Dispatch::Wrapper; use Moo; 1"
16 or die "Failed to setup app package: $@";
18 warnings::illegalproto->unimport;
22 my ($class, $app_package) = @_;
25 *{"${app_package}::PSGI_ENV"} = sub () { -1 };
26 require Web::Simple::Application;
27 unshift(@{"${app_package}::ISA"}, 'Web::Simple::Application');
29 (my $name = $app_package) =~ s/::/\//g;
30 $INC{"${name}.pm"} = 'Set by "use Web::Simple;" invocation';
35 Web::Simple - A quick and easy way to build simple web applications
39 This is really quite new. If you're reading this on CPAN, it means the stuff
40 that's here we're probably happy with. But only probably. So we may have to
41 change stuff. And if you're reading this from git, come check with irc.perl.org
42 #web-simple that we're actually sure we're going to keep anything that's
43 different from the CPAN version.
45 If we do find we have to change stuff we'll add to the
46 L<CHANGES BETWEEN RELEASES> section explaining how to switch your code across
47 to the new version, and we'll do our best to make it as painless as possible
48 because we've got Web::Simple applications too. But we can't promise not to
49 change things at all. Not yet. Sorry.
55 use Web::Simple 'HelloWorld';
60 sub dispatch_request {
62 [ 200, [ 'Content-type', 'text/plain' ], [ 'Hello world!' ] ]
65 [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
70 HelloWorld->run_if_script;
72 If you save this file into your cgi-bin as C<hello-world.cgi> and then visit:
74 http://my.server.name/cgi-bin/hello-world.cgi/
76 you'll get the "Hello world!" string output to your browser. For more complex
77 examples and non-CGI deployment, see below. To get help with Web::Simple,
78 please connect to the irc.perl.org IRC network and join #web-simple.
82 The philosophy of L<Web::Simple> is to keep to an absolute bare minimum, for
83 everything. It is not designed to be used for large scale applications;
84 the L<Catalyst> web framework already works very nicely for that and is
85 a far more mature, well supported piece of software.
87 However, if you have an application that only does a couple of things, and
88 want to not have to think about complexities of deployment, then L<Web::Simple>
89 might be just the thing for you.
91 The only public interface the Web::Simple module itself provides is an
94 use Web::Simple 'NameOfApplication';
96 This setups up your package (in this case "NameOfApplication" is your package)
97 so that it inherits from L<Web::Simple::Application> and imports L<strictures>,
98 as well as installs a C<PSGI_ENV> constant for convenience, as well as some
101 Importing L<strictures> will automatically make you code use the C<strict> and
102 C<warnings> pragma, so you can skip the usual:
105 use warnings FATAL => 'aa';
107 provided you 'use Web::Simple' at the top of the file. Note that we turn
108 on *fatal* warnings so if you have any warnings at any point from the file
109 that you did 'use Web::Simple' in, then your application will die. This is,
110 so far, considered a feature.
112 When we inherit from L<Web::Simple::Application> we also use <Moo>, which is
113 the the equivalent of:
116 package NameOfApplication;
118 extends 'Web::Simple::Application';
121 It also exports the following subroutines for use in dispatchers:
123 response_filter { ... };
125 redispatch_to '/somewhere';
129 $INC{"NameOfApplication.pm"} = 'Set by "use Web::Simple;" invocation';
131 so that perl will not attempt to load the application again even if
133 require NameOfApplication;
135 is encountered in other code.
137 =head1 DISPATCH STRATEGY
139 L<Web::Simple> dispite being straightforward to use, has a powerful system
140 for matching all sorts of incoming URLs to one or more subroutines. These
141 subroutines can be simple actions to take for a given URL, or something
142 more complicated, including entire L<Plack> applications, L<Plack::Middleware>
143 and nested subdispatchers.
147 sub dispatch_request {
148 # matches: GET /user/1.htm?show_details=1
150 sub (GET + /user/* + ?show_details~ + .htm|.html|.xhtml) {
151 my ($self, $user_id, $show_details) = @_;
154 # matches: POST /user?username=frew
155 # POST /user?username=mst&first_name=matt&last_name=trout
156 sub (POST + /user + ?username=&*) {
157 my ($self, $username, $misc_params) = @_;
160 # matches: DELETE /user/1/friend/2
161 sub (DELETE + /user/*/friend/*) {
162 my ($self, $user_id, $friend_id) = @_;
165 # matches: PUT /user/1?first_name=Matt&last_name=Trout
166 sub (PUT + /user/* + ?first_name~&last_name~) {
167 my ($self, $user_id, $first_name, $last_name) = @_;
172 # matches: PUT /user/1/role/1
173 sub (PUT + /role/*) {
177 # matches: DELETE /user/1/role/1
178 sub (DELETE + /role/*) {
185 =head2 The dispatch cycle
187 At the beginning of a request, your app's dispatch_request method is called
188 with the PSGI $env as an argument. You can handle the request entirely in
189 here and return a PSGI response arrayref if you want:
191 sub dispatch_request {
192 my ($self, $env) = @_;
193 [ 404, [ 'Content-type' => 'text/plain' ], [ 'Amnesia == fail' ] ]
196 However, generally, instead of that, you return a set of dispatch subs:
198 sub dispatch_request {
200 sub (/) { redispatch_to '/index.html' },
201 sub (/user/*) { $self->show_user($_[1]) },
205 If you return a subroutine with a prototype, the prototype is treated
206 as a match specification - and if the test is passed, the body of the
207 sub is called as a method any matched arguments (see below for more details).
209 You can also return a plain subroutine which will be called with just $env
210 - remember that in this case if you need $self you -must- close over it.
212 If you return a normal object, L<Web::Simple> will simply return it upwards on
213 the assumption that a response_filter (or some arbitrary L<Plack::Middleware>)
214 somewhere will convert it to something useful. This allows:
216 sub dispatch_request {
218 sub (.html) { response_filter { $self->render_zoom($_[0]) } },
219 sub (/user/*) { $self->users->get($_[1]) },
222 to render a user object to HTML, if there is an incoming URL such as:
224 http://myweb.org/user/111.html
226 This works because as we descend down the dispachers, we first match
227 C<sub (.html)>, which adds a C<response_filter> (basically a specialized routine
228 that follows the L<Plack::Middleware> specification), and then later we also
229 match C<sub (/user/*)> which gets a user and returns that as the response.
230 This user object 'bubbles up' through all the wrapping middleware until it hits
231 the C<response_filter> we defined, after which the return is converted to a
234 However, two types of object are treated specially - a Plack::App object
235 will have its C<->to_app> method called and be used as a dispatcher:
237 sub dispatch_request {
239 sub (/static/...) { Plack::App::File->new(...) },
243 A Plack::Middleware object will be used as a filter for the rest of the
244 dispatch being returned into:
246 ## responds to /admin/track_usage AND /admin/delete_accounts
248 sub dispatch_request {
251 Plack::Middleware::Session->new(%opts);
253 sub (/admin/track_usage) {
254 ## something that needs a session
256 sub (/admin/delete_accounts) {
257 ## something else that needs a session
261 Note that this is for the dispatch being -returned- to, so if you want to
262 provide it inline you need to do:
264 ## ALSO responds to /admin/track_usage AND /admin/delete_accounts
266 sub dispatch_request {
270 Plack::Middleware::Session->new(%opts);
273 ## something that needs a session
275 sub (/delete_accounts) {
276 ## something else that needs a session
281 And that's it - but remember that all this happens recursively - it's
282 dispatchers all the way down. A URL incoming pattern will run all matching
283 dispatchers and then hit all added filters or L<Plack::Middleware>.
285 =head2 Web::Simple match specifications
287 =head3 Method matches
291 A match specification beginning with a capital letter matches HTTP requests
292 with that request method.
298 A match specification beginning with a / is a path match. In the simplest
299 case it matches a specific path. To match a path with a wildcard part, you
303 $self->handle_user($_[1])
305 This will match /user/<anything> where <anything> does not include a literal
306 / character. The matched part becomes part of the match arguments. You can
307 also match more than one part:
310 my ($self, $user_1, $user_2) = @_;
312 sub (/domain/*/user/*) {
313 my ($self, $domain, $user) = @_;
315 and so on. To match an arbitrary number of parts, use -
319 This will result in an element per /-separated part so matched. Note that
322 sub (/page/**/edit) {
324 to match an arbitrary number of parts up to but not including some final
331 will match /foo/ on the beginning of the path -and- strip it, much like
332 .html strips the extension. This is designed to be used to construct
333 nested dispatch structures, but can also prove useful for having e.g. an
334 optional language specification at the start of a path.
336 Note that the '...' is a "maybe something here, maybe not" so the above
337 specification will match like this:
340 /foo/ # match and strip path to '/'
341 /foo/bar/baz # match and strip path to '/bar/baz'
343 =head3 Extension matches
347 will match and strip .html from the path (assuming the subroutine itself
348 returns something, of course). This is normally used for rendering - e.g.
351 response_filter { $self->render_html($_[1]) }
358 will match any extension and supplies the stripped extension as a match
361 =head3 Query and body parameter matches
363 Query and body parameters can be match via
365 sub (?<param spec>) { # match URI query
366 sub (%<param spec>) { # match body params
368 The body is only matched if the content type is
369 application/x-www-form-urlencoded (note this means that Web::Simple does
370 not yet handle uploads; this will be addressed in a later release).
372 The param spec is elements of one of the following forms -
374 param~ # optional parameter
375 param= # required parameter
376 @param~ # optional multiple parameter
377 @param= # required multiple parameter
378 :param~ # optional parameter in hashref
379 :param= # required parameter in hashref
380 :@param~ # optional multiple in hashref
381 :@param= # required multiple in hashref
382 * # include all other parameters in hashref
383 @* # include all other parameters as multiple in hashref
385 separated by the & character. The arguments added to the request are
386 one per non-:/* parameter (scalar for normal, arrayref for multiple),
387 plus if any :/* specs exist a hashref containing those values.
389 Please note that if you specify a multiple type parameter match, you are
390 ensured of getting an arrayref for the value, EVEN if the current incoming
391 request has only one value. However if a parameter is specified as single
392 and multiple values are found, the last one will be used.
394 For example to match a page parameter with an optional order_by parameter one
397 sub (?page=&order_by~) {
398 my ($self, $page, $order_by) = @_;
399 return unless $page =~ /^\d+$/;
402 $_[1]->search_rs({}, $p);
406 to implement paging and ordering against a L<DBIx::Class::ResultSet> object.
408 Another Example: To get all parameters as a hashref of arrayrefs, write:
411 my ($self, $params) = @_;
414 To get two parameters as a hashref, write:
416 sub(?:user~&:domain~) {
417 my ($self, $params) = @_; # params contains only 'user' and 'domain' keys
419 You can also mix these, so:
421 sub (?foo=&@bar~&:coffee=&@*) {
422 my ($self, $foo, $bar, $params);
424 where $bar is an arrayref (possibly an empty one), and $params contains
425 arrayref values for all parameters -not- mentioned and a scalar value for
426 the 'coffee' parameter.
428 Note, in the case where you combine arrayref, single parameter and named
429 hashref style, the arrayref and single parameters will appear in C<@_> in the
430 order you defined them in the protoype, but all hashrefs will merge into a
431 single C<$params>, as in the example above.
433 =head3 Combining matches
435 Matches may be combined with the + character - e.g.
437 sub (GET + /user/*) {
439 to create an AND match. They may also be combined withe the | character - e.g.
443 to create an OR match. Matches can be nested with () - e.g.
445 sub ((GET|POST) + /user/*) {
447 and negated with ! - e.g.
449 sub (!/user/foo + /user/*) {
451 ! binds to the immediate rightmost match specification, so if you want
452 to negate a combination you will need to use
454 sub ( !(POST|PUT|DELETE) ) {
456 and | binds tighter than +, so
458 sub ((GET|POST) + /user/*) {
462 sub (GET|POST + /user/*) {
466 sub ((GET + .html) | (POST + .html)) {
470 sub (GET + .html | POST + .html) {
472 are not - the latter is equivalent to
474 sub (GET + (.html|POST) + .html) {
476 which will never match!
480 Note that for legibility you are permitted to use whitespace -
482 sub (GET + /user/*) {
484 but it will be ignored. This is because the perl parser strips whitespace
485 from subroutine prototypes, so this is equivalent to
489 =head3 Accessing the PSGI env hash
491 In some cases you may wish to get the raw PSGI env hash - to do this,
492 you can either use a plain sub -
499 or use the PSGI_ENV constant exported to retrieve it:
501 sub (GET + /foo + ?some_param=) {
503 my $env = $_[PSGI_ENV];
506 but note that if you're trying to add a middleware, you should simply use
507 Web::Simple's direct support for doing so.
509 =head1 EXPORTED SUBROUTINES
511 =head2 response_filter
514 # Hide errors from the user because we hates them, preciousss
515 if (ref($_[0]) eq 'ARRAY' && $_[0]->[0] == 500) {
516 $_[0] = [ 200, @{$_[0]}[1..$#{$_[0]}] ];
521 The response_filter subroutine is designed for use inside dispatch subroutines.
523 It creates and returns a special dispatcher that always matches, and calls
524 the block passed to it as a filter on the result of running the rest of the
525 current dispatch chain.
527 Thus the filter above runs further dispatch as normal, but if the result of
528 dispatch is a 500 (Internal Server Error) response, changes this to a 200 (OK)
529 response without altering the headers or body.
533 redispatch_to '/other/url';
535 The redispatch_to subroutine is designed for use inside dispatch subroutines.
537 It creates and returns a special dispatcher that always matches, and instead
538 of continuing dispatch re-delegates it to the start of the dispatch process,
539 but with the path of the request altered to the supplied URL.
541 Thus if you receive a POST to '/some/url' and return a redispatch to
542 '/other/url', the dispatch behaviour will be exactly as if the same POST
543 request had been made to '/other/url' instead.
545 Note, this is not the same as returning an HTTP 3xx redirect as a response;
546 rather it is a much more efficient internal process.
548 =head1 CHANGES BETWEEN RELEASES
550 =head2 Changes between 0.004 and 0.005
554 =item * dispatch {} replaced by declaring a dispatch_request method
556 dispatch {} has gone away - instead, you write:
558 sub dispatch_request {
560 sub (GET /foo/) { ... },
564 Note that this method is still -returning- the dispatch code - just like
567 Also note that you need the 'my $self = shift' since the magic $self
570 =item * the magic $self variable went away.
572 Just add 'my $self = shift;' while writing your 'sub dispatch_request {'
573 like a normal perl method.
575 =item * subdispatch deleted - all dispatchers can now subdispatch
577 In earlier releases you needed to write:
579 subdispatch sub (/foo/...) {
582 sub (GET /bar/) { ... },
587 As of 0.005, you can instead write simply:
592 sub (GET /bar/) { ... },
597 =head2 Changes since Antiquated Perl
601 =item * filter_response renamed to response_filter
603 This is a pure rename; a global search and replace should fix it.
605 =item * dispatch [] changed to dispatch {}
609 dispatch [ sub(...) { ... }, ... ];
613 dispatch { sub(...) { ... }, ... };
619 =head1 DEVELOPMENT HISTORY
621 Web::Simple was originally written to form part of my Antiquated Perl talk for
622 Italian Perl Workshop 2009, but in writing the bloggery example I realised
623 that having a bare minimum system for writing web applications that doesn't
624 drive me insane was rather nice and decided to spend my attempt at nanowrimo
625 for 2009 improving and documenting it to the point where others could use it.
627 The Antiquated Perl talk can be found at L<http://www.shadowcat.co.uk/archive/conference-video/>.
629 =head1 COMMUNITY AND SUPPORT
633 irc.perl.org #web-simple
635 =head2 No mailing list yet
637 Because mst's non-work email is a bombsite so he'd never read it anyway.
639 =head2 Git repository
641 Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
643 git clone git://git.shadowcat.co.uk/catagits/Web-Simple.git
647 Matt S. Trout <mst@shadowcat.co.uk>
651 None required yet. Maybe this module is perfect (hahahahaha ...).
655 Copyright (c) 2009 the Web::Simple L</AUTHOR> and L</CONTRIBUTORS>
660 This library is free software and may be distributed under the same terms