1 package Web::Dispatch::HTTPMethods;
4 use Web::Dispatch::Predicates qw(match_method);
5 use Scalar::Util qw(blessed);
8 our @EXPORT = qw(GET HEAD POST PUT DELETE OPTIONS);
10 sub HEAD(&;@) { method_helper(HEAD => @_) }
11 sub GET(&;@) { method_helper(GET => @_) }
12 sub POST(&;@) { method_helper(POST => @_) }
13 sub PUT(&;@) { method_helper(PUT => @_) }
14 sub DELETE(&;@) { method_helper(DELETE => @_) }
15 sub OPTIONS(&;@) { method_helper(OPTIONS => @_) }
18 package Web::Dispatch::HTTPMethods::Endpoint;
20 sub new { bless { map { $_=>0 } @EXPORT }, shift }
21 sub hdrs { 'Content-Type' => 'text/plain' }
23 sub create_implicit_HEAD {
25 if($self->{GET} && not $self->{HEAD}) {
26 $self->{HEAD} = sub { [ @{$self->{GET}->(@_)}[0,1], []] };
30 sub create_implicit_OPTIONS {
32 $self->{OPTIONS} = sub {
33 [200, [$self->hdrs, Allow=>$self->allowed] , [] ];
37 sub allowed { join ',', grep { $_[0]->{$_} } @EXPORT }
41 my $implicit_HEAD = $self->create_implicit_HEAD;
42 my $implicit_OPTIONS = $self->create_implicit_OPTIONS;
46 if($env->{REQUEST_METHOD} eq 'HEAD') {
47 $implicit_HEAD->($env);
48 } elsif($env->{REQUEST_METHOD} eq 'OPTIONS') {
49 $implicit_OPTIONS->($env);
51 [405, [$self->hdrs, Allow=>$self->allowed] , ['Method Not Allowed'] ];
59 $_[0]->isa('Web::Dispatch::HTTPMethods::Endpoint')
62 sub endpoint_from { return $_[-1] }
63 sub new_endpoint { Web::Dispatch::HTTPMethods::Endpoint->new(@_) }
66 my $predicate = match_method(my $method = shift);
67 my ($code, @following ) = @_;
68 endpoint_from( my @dispatchers =
69 scalar(@following) ? ($predicate, @_) : ($predicate, @_, new_endpoint)
72 die "Non HTTP Method dispatcher detected in HTTP Method scope"
73 unless(isa_endpoint($dispatchers[-1]));
83 Web::Dispatch::HTTPMethods - Helpers to make RESTFul Dispatchers Easier
87 package MyApp:WithHTTPMethods;
90 use Web::Dispatch::HTTPMethods;
93 [200, ['Content-Type' => 'text/plain'],
94 [$_[0]->{REQUEST_METHOD}, $_[0]->{REQUEST_URI}] ]
97 sub dispatch_request {
103 HEAD { [204,[],[]] },
105 sub (/get-post-put) {
106 GET { as_text(pop) } ## NOTE: no commas separating http methods
107 POST { as_text(pop) }
114 Exports the most commonly used HTTP methods as subroutine helpers into your
115 L<Web::Simple> based application.
116 Use of these methods additionally adds an automatic HTTP code 405
117 C<Method Not Allowed> response if none of the HTTP methods match for a given dispatch and
118 also adds a dispatch rule for C<HEAD> if no C<HEAD> exists but a C<GET> does
119 (in which case the C<HEAD> returns the C<GET> dispatch with an empty body.)
121 We also add support at the end of the chain for the OPTIONS method.
122 This defaults to HTTP 200 OK + Allows http headers.
124 We also try to set correct HTTP headers such as C<Allows> as makes sense based
125 on your dispatch chain.
127 The following dispatch chains are basically the same:
129 sub dispatch_request {
130 sub (/get-http-methods) {
131 GET { [200, ['Content-Type' => 'text/plain'], ['Hello World']] }
134 sub (GET) { [200, ['Content-Type' => 'text/plain'], ['Hello World']] },
135 sub (HEAD) { [200, ['Content-Type' => 'text/plain'], []] },
137 [200, ['Content-Type' => 'text/plain', Allows=>'GET,HEAD,OPTIONS'], []];
140 [405, ['Content-Type' => 'text/plain', Allows=>'GET,HEAD,OPTIONS'],
141 ['Method Not Allowed']]
146 The idea here is less boilerplate to distract the reader from the main point of
147 the code and also to encapsulate some best practices.
149 B<NOTE> You currently cannot mix http method style and prototype sub style in
150 the same scope, as in the following example:
152 sub dispatch_request {
159 If you try this our code will notice and issue a C<die>. If you have a good use
160 case please bring it to the authors.
164 This automatically exports the following subroutines:
175 See L<Web::Simple> for AUTHOR
179 See L<Web::Simple> for CONTRIBUTORS
183 See L<Web::Simple> for COPYRIGHT
187 See L<Web::Simple> for LICENSE