lib/Catalyst/Action/REST.pm

   1 #
   2 # REST.pm
   3 # Created by: Adam Jacob, Marchex, <adam@marchex.com>
   4 # Created on: 10/12/2006 03:00:32 PM PDT
   5 #
   6 # $Id$
   7
   8 package Catalyst::Action::REST;
   9
  10 use strict;
  11 use warnings;
  12
  13 use base 'Catalyst::Action';
  14 use Class::Inspector;
  15 use 5.8.1;
  16
  17 our
  18 $VERSION = '0.31';
  19
  20 =head1 NAME
  21
  22 Catalyst::Action::REST - Automated REST Method Dispatching
  23
  24 =head1 SYNOPSIS
  25
  26     sub foo :Local :ActionClass('REST') {
  27       ... do setup for HTTP method specific handlers ...
  28     }
  29
  30     sub foo_GET {
  31       ... do something for GET requests ...
  32     }
  33
  34     sub foo_PUT {
  35       ... do somethign for PUT requests ...
  36     }
  37
  38 =head1 DESCRIPTION
  39
  40 This Action handles doing automatic method dispatching for REST requests.  It
  41 takes a normal Catalyst action, and changes the dispatch to append an
  42 underscore and method name.
  43
  44 For example, in the synopsis above, calling GET on "/foo" would result in
  45 the foo_GET method being dispatched.
  46
  47 If a method is requested that is not implemented, this action will
  48 return a status 405 (Method Not Found).  It will populate the "Allow" header
  49 with the list of implemented request methods.  You can override this behavior
  50 by implementing a custom 405 handler like so:
  51
  52    sub foo_not_implemented {
  53       ... handle not implemented methods ...
  54    }
  55
  56 If you do not provide an _OPTIONS subroutine, we will automatically respond
  57 with a 200 OK.  The "Allow" header will be populated with the list of
  58 implemented request methods.
  59
  60 It is likely that you really want to look at L<Catalyst::Controller::REST>,
  61 which brings this class together with automatic Serialization of requests
  62 and responses.
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item dispatch
  69
  70 This method overrides the default dispatch mechanism to the re-dispatching
  71 mechanism described above.
  72
  73 =cut
  74
  75 sub dispatch {
  76     my $self = shift;
  77     my $c    = shift;
  78
  79     my $controller = $self->class;
  80     my $method     = $self->name . "_" . uc( $c->request->method );
  81     if ( $controller->can($method) ) {
  82         $c->execute( $self->class, $self, @{ $c->req->args } );
  83         return $controller->$method( $c, @{ $c->req->args } );
  84     } else {
  85         if ( $c->request->method eq "OPTIONS" ) {
  86             return $self->_return_options($c);
  87         } else {
  88             my $handle_ni = $self->name . "_not_implemented";
  89             if ( $controller->can($handle_ni) ) {
  90                 return $controller->$handle_ni( $c, @{ $c->req->args } );
  91             } else {
  92                 return $self->_return_not_implemented($c);
  93             }
  94         }
  95     }
  96 }
  97
  98 sub _return_options {
  99     my ( $self, $c ) = @_;
 100
 101     my @allowed = $self->_get_allowed_methods($c);
 102     $c->response->content_type('text/plain');
 103     $c->response->status(200);
 104     $c->response->header( 'Allow' => \@allowed );
 105 }
 106
 107 sub _get_allowed_methods {
 108     my ( $self, $c ) = @_;
 109
 110     my $controller = $self->class;
 111     my $methods    = Class::Inspector->methods($controller);
 112     my @allowed;
 113     foreach my $method ( @{$methods} ) {
 114         my $name = $self->name;
 115         if ( $method =~ /^$name\_(.+)$/ ) {
 116             push( @allowed, $1 );
 117         }
 118     }
 119     return @allowed;
 120 }
 121
 122 sub _return_not_implemented {
 123     my ( $self, $c ) = @_;
 124
 125     my @allowed = $self->_get_allowed_methods($c);
 126     $c->response->content_type('text/plain');
 127     $c->response->status(405);
 128     $c->response->header( 'Allow' => \@allowed );
 129     $c->response->body( "Method "
 130           . $c->request->method
 131           . " not implemented for "
 132           . $c->uri_for( $self->reverse ) );
 133 }
 134
 135 1;
 136
 137 =back
 138
 139 =head1 SEE ALSO
 140
 141 You likely want to look at L<Catalyst::Controller::REST>, which implements
 142 a sensible set of defaults for a controller doing REST.
 143
 144 L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>
 145
 146 =head1 AUTHOR
 147
 148 Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway
 149
 150 Marchex, Inc. paid me while I developed this module.  (http://www.marchex.com)
 151
 152 =head1 CONTRIBUTERS
 153
 154 Daisuke Maki <daisuke@endeworks.jp>
 155
 156 =head1 LICENSE
 157
 158 You may distribute this code under the same terms as Perl itself.
 159
 160 =cut
 161