X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAction%2FREST.pm;h=9787eef99d1aaba73459188e32f43ec7c9b5981d;hb=ffcae14131f4334ab08b42e5eed0b012933f51df;hp=6862f71cdba13e9c9248d70ffa482baf8115facb;hpb=10bcd217c37d68aabbb0db8a5a7e233e679cb945;p=catagits%2FCatalyst-Action-REST.git diff --git a/lib/Catalyst/Action/REST.pm b/lib/Catalyst/Action/REST.pm index 6862f71..9787eef 100644 --- a/lib/Catalyst/Action/REST.pm +++ b/lib/Catalyst/Action/REST.pm @@ -1,23 +1,23 @@ package Catalyst::Action::REST; -use strict; -use warnings; +use Moose; +use namespace::autoclean; -use base 'Catalyst::Action'; +extends 'Catalyst::Action'; use Class::Inspector; use Catalyst::Request::REST; use Catalyst::Controller::REST; BEGIN { require 5.008001; } -our $VERSION = '0.79'; +our $VERSION = '1.02'; $VERSION = eval $VERSION; -sub new { - my $class = shift; - my $config = shift; - Catalyst::Request::REST->_insert_self_into( $config->{class} ); - return $class->next::method($config, @_); +sub BUILDARGS { + my $class = shift; + my $config = shift; + Catalyst::Request::REST->_insert_self_into( $config->{class} ); + return $class->SUPER::BUILDARGS($config, @_); } =head1 NAME @@ -67,8 +67,8 @@ It is likely that you really want to look at L, which brings this class together with automatic Serialization of requests and responses. -When you use this module, the request class will be changed to -L. +When you use this module, it adds the L +role to your request class. =head1 METHODS @@ -85,54 +85,72 @@ sub dispatch { my $self = shift; my $c = shift; - my $controller = $c->component( $self->class ); my $rest_method = $self->name . "_" . uc( $c->request->method ); + return $self->_dispatch_rest_method( $c, $rest_method ); +} + +sub _dispatch_rest_method { + my $self = shift; + my $c = shift; + my $rest_method = shift; + my $req = $c->request; + + my $controller = $c->component( $self->class ); + my ($code, $name); + # Execute normal 'foo' action. + $c->execute( $self->class, $self, @{ $req->args } ); + # Common case, for foo_GET etc if ( $code = $controller->action_for($rest_method) ) { - $c->execute( $self->class, $self, @{ $c->req->args } ); - return $c->forward( $code, $c->req->args ); - } elsif ($code = $controller->can($rest_method)) { - # Exceute normal action - $c->execute( $self->class, $self, @{ $c->req->args } ); - $name = $rest_method; + return $c->forward( $code, $req->args ); # Forward to foo_GET if it's an action } - - # Generic handling for foo_OPTIONS - if (!$code && $c->request->method eq "OPTIONS") { - $name = $rest_method; - $code = sub { $self->_return_options($self->name, @_) }; + elsif ($code = $controller->can($rest_method)) { + $name = $rest_method; # Stash name and code to run 'foo_GET' like an action below. } - # Otherwise, not implemented. + # Generic handling for foo_* if (!$code) { - $name = $self->name . "_not_implemented"; - $code = $controller->can($name) # User method - # Generic not implemented - || sub { $self->_return_not_implemented($self->name, @_) }; + my $code_action = { + OPTIONS => sub { + $name = $rest_method; + $code = sub { $self->_return_options($self->name, @_) }; + }, + HEAD => sub { + $rest_method =~ s{_HEAD$}{_GET}i; + $self->_dispatch_rest_method($c, $rest_method); + }, + default => sub { + # Otherwise, not implemented. + $name = $self->name . "_not_implemented"; + $code = $controller->can($name) # User method + # Generic not implemented + || sub { $self->_return_not_implemented($self->name, @_) }; + }, + }; + my $respond = ($code_action->{$req->method} + || $code_action->{'default'})->(); + return $respond unless $name; } # localise stuff so we can dispatch the action 'as normal, but get # different stats shown, and different code run. + # Also get the full path for the action, and make it look like a forward local $self->{code} = $code; - local $self->{reverse} = $name; + my @name = split m{/}, $self->reverse; + $name[-1] = $name; + local $self->{reverse} = "-> " . join('/', @name); - $c->execute( $self->class, $self, @{ $c->req->args } ); + $c->execute( $self->class, $self, @{ $req->args } ); } sub _get_allowed_methods { my ( $self, $controller, $c, $name ) = @_; my $class = ref($controller) ? ref($controller) : $controller; - my $methods = Class::Inspector->methods($class); - my @allowed; - foreach my $method ( @{$methods} ) { - if ( $method =~ /^$name\_(.+)$/ ) { - push( @allowed, $1 ); - } - } - return @allowed; + my $methods = Class::Inspector->methods($class); + return map { /^$name\_(.+)$/ } @$methods; }; sub _return_options { @@ -141,6 +159,7 @@ sub _return_options { $c->response->content_type('text/plain'); $c->response->status(200); $c->response->header( 'Allow' => \@allowed ); + $c->response->body(q{}); } sub _return_not_implemented { @@ -156,14 +175,21 @@ sub _return_not_implemented { . $c->uri_for( $method_name ) ); } +__PACKAGE__->meta->make_immutable; + 1; =back =head1 SEE ALSO -You likely want to look at L, which implements -a sensible set of defaults for a controller doing REST. +You likely want to look at L, which implements a +sensible set of defaults for a controller doing REST. + +This class automatically adds the L role to +your request class. If you're writing a web application which provides RESTful +responses and still needs to accommodate web browsers, you may prefer to use +L instead. L, L @@ -186,31 +212,41 @@ for this to run smoothly. =head1 AUTHOR -Adam Jacob , with lots of help from mst and jrockway +Adam Jacob Eadam@stalecoffee.orgE, with lots of help from mst and jrockway Marchex, Inc. paid me while I developed this module. (L) =head1 CONTRIBUTORS -Arthur Axel "fREW" Schmidt +Tomas Doran (t0m) Ebobtfish@bobtfish.netE + +John Goulah Christopher Laco +Daisuke Maki Edaisuke@endeworks.jpE + +Hans Dieter Pearcey + +Brian Phillips Ebphillips@cpan.orgE + +Dave Rolsky Eautarch@urth.orgE + Luke Saunders -John Goulah +Arthur Axel "fREW" Schmidt Efrioux@gmail.comE -Daisuke Maki +J. Shirley Ejshirley@gmail.comE -J. Shirley +Gavin Henry Eghenry@surevoip.co.ukE -Hans Dieter Pearcey +Gerv http://www.gerv.net/ -Tomas Doran (t0m) +Colin Newell =head1 COPYRIGHT -Copyright the above named AUTHOR and CONTRIBUTORS +Copyright (c) 2006-2012 the above named AUTHOR and CONTRIBUTORS =head1 LICENSE