[Catalyst] RESTful perl implementations...

[Garrett Goebel]

I'm sure this is too late to be useful. But here is my subclassed  
Catalyst::Action to implemented RESTful request method based  
dispatching. [I've been working on this in my free time. Which I have  
precious little of lately. My apologies.]

The references to $c->request->path_parameters are to support RoR  
style processing of urls (foo.com/person;create) where  
Catalyst::Dispatcher->perpare_action is overridden to match url paths  
separate from path parameters and file extensions.

I also override Catalyst::Dispatcher->setup_actions to change the  
default method_action_class to my subclass of Catalyst::Action. I was  
surprised that default method_action_class and action_container_class  
appear to be hard coded...


package Catalyst::Reagent::Action;
use 5.008;
use strict;
use warnings;
use version; our $VERSION = qv('0.0.1');
use base qw(Catalyst::Action);
use List::MoreUtils qw(any);
use Readonly;

lexical_scope: {

Readonly my @ok_methods => (qw/GET POST PUT DELETE/);

sub match {
     my $self = shift;
     my ($c)  = @_;

     # Request method must match any specified REST methods for action
     my @allow_methods = grep { exists $self->attributes->{$_} }  
@ok_methods;
     if (@allow_methods) {
         # intersection of @allow_methods and $request_method is not  
empty set
         my $request_method = $c->request->method;
         return 0 if ! any { $request_method eq $_ } @allow_methods;
         $c->log->debug('Request method is: ' . $request_method);
     }

     # Request uri must match any specified path parameters for action
     if (exists $self->attributes->{PathParam}) {
         my $allow_params     = $self->attributes->{PathParam};
         my $request_param_of = $c->request->path_parameters;
         return 0 if ! any { exists $request_param_of->{$_} } @ 
$allow_params;
         $c->log->debug('PathParam: '. join(', ', keys % 
$request_param_of));
     }

     return $self->NEXT::match(@_);
}

}

1;