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 helps into your
115 L<Web::Simple> based application. Additionally adds an automatic HTTP code 405
116 C<Method Not Allow> if none of the HTTP methods match for a given dispatch and
117 also adds a dispatch rule for C<HEAD> if no C<HEAD> exists but a C<GET> does
118 (in which case the C<HEAD> returns the C<GET> dispatch with an empty body.)
120 We also add at the end of the chain support for the OPTIONS method (if you do
121 not add one yourself. This defaults to http 200 ok + Allows http headers.
123 Also we try to set correct HTTP headers such as C<Allows> as makes sense based
124 on your dispatch chain.
126 The following dispatch chains are basically the same:
128 sub dispatch_request {
129 sub (/get-http-methods) {
130 GET { [200, ['Content-Type' => 'text/plain'], ['Hello World']] }
133 sub (GET) { [200, ['Content-Type' => 'text/plain'], ['Hello World']] },
134 sub (HEAD) { [200, ['Content-Type' => 'text/plain'], []] },
136 [200, ['Content-Type' => 'text/plain', Allows=>'GET,HEAD,OPTIONS'], []];
139 [405, ['Content-Type' => 'text/plain', Allows=>'GET,HEAD,OPTIONS'],
140 ['Method Not Allowed']]
145 The idea here is less boilerplate to distract the reader from the main point of
146 the code and also to encapsulate some best practices.
148 B<NOTE> You currently cannot mix http method style and prototype sub style in
149 the same scope, as in the following example:
151 sub dispatch_request {
158 If you try this our code will notice and issue a C<die>. If you have a good use
159 case please bring it to the authors.
163 This automatically exports the following subroutines:
174 See L<Web::Simple> for AUTHOR
178 See L<Web::Simple> for CONTRIBUTORS
182 See L<Web::Simple> for COPYRIGHT
186 See L<Web::Simple> for LICENSE