http://qs321.pair.com?node_id=591056

Any comments on this module before I upload it to CPAN. (Got to fill out that test suite first!) I am particularly interested in the quality of the documentation, whether it is missing any features (patches welcome!) and if you would find it useful but any constructive criticism would be great.

Update: some typos fixed and readmore tags added around the code.

package CGI::Application::Plugin::REST; use warnings; use strict; use Carp; use base 'Exporter'; our @EXPORT = qw/ REST_error REST_route REST_media_type /; # remember to keep version number in sync with the POD below our $VERSION = '0.8'; # plug in to CGI::Application and setup our callbacks. sub import{ my $caller = scalar(caller); $caller->add_callback('init', 'CGI::Application::Plugin::REST::REST_init'); $caller->add_callback('prerun', 'CGI::Application::Plugin::REST::REST_dispatch'); goto &Exporter::import; } # REST_init # Set up our variables # sub REST_init { my ($self) = @_; $self->{REST_dispatch_table} = {}; $self->{REST_my_media_type} = undef; } # REST_dispatch # A cgiapp_prerun hook that maps requests to the right functions # sub REST_dispatch { my ($self, $run_mode) = @_; my $q = $self->query; # Is this a REST run_mode? Yes then wrap the whole thing up in an +eval if (exists($self->{REST_dispatch_table}->{$run_mode})) { eval { my $rest_run_mode = $self->{REST_dispatch_table}->{$run_mode}; # If so, create a dummy real run_mode for it (or supress an ex +isting # one.) This is becuse we run fro cgiapp_prerun() which wants + to # return to a real run_mode. $self->run_modes($run_mode => sub {}); # Is the request method (GET, POST) valid for our REST run_mod +e? my $request_method = $q->request_method; if (defined($request_method) && exists($rest_run_mode->{$request_method})) { my $dispatch = $rest_run_mode->{$request_method}; # Get the preferred MIME media type. Other HTTP verbs tha +n the # ones below (and DELETE) are not covered. Should they be +? my $media_type = undef; if ($request_method eq 'GET' || $request_method eq 'HEAD') + { my $quality = 0.000; foreach my $type (keys %$dispatch) { my $temp_quality = $q->Accept($type); if ($temp_quality > $quality) { $quality = $temp_quality; $media_type = $type; } } } elsif ($request_method eq 'POST' || $request_method eq 'PU +T') { $media_type = $q->content_type; } $self->{REST_my_media_type} = $media_type; # Is the MIME media type valid for our REST run_mode? DEL +ETE # doesn't care about the media type so skip check in that +case. if ((defined($media_type) && exists($dispatch->{$media_typ +e})) || $request_method eq 'DELETE') { # Get the function to call. The rest of the array is t +he # arguments we want to give to that function... my @args = @{$dispatch->{$media_type}}; my $function = shift @args; # ...which we get from the CGI parameters. my $params; foreach my $arg (@args) { $params->{$arg} = $q->param($arg) || ''; } # Try and run the method passing it a hashref of the a +rguments. if (my $sub = $self->can($function)) { no strict 'refs'; $self->run_modes( $run_mode => sub { return $sub->($self, $param +s) } ); } # We couldn't find or run the specified method. else { $self->REST_error('403', "Function doesn't exist") +; } } # We didn't get an acceptable MIME media type. else { $self->REST_error('415', 'Unsupported media type'); } } # We didn't get an acceptable request method. else { $self->REST_error('405', 'Method not allowed'); } }}; # trap any errors and pass them on to the error mode. if ($@) { REST_error('500', 'Application error'); my $error = $@; $self->call_hook('error', $error); if (my $em = $self->error_mode) { $self->$em( $error ); } else { croak("Error executing REST run mode '$run_mode': $error") +; } } } # REST_error # prepare an error message # sub REST_error { my ($self, $code, $msg) = @_; $self->header_add(-status => "$code $msg"); die "$code $msg\n"; } # REST_media_type # Return the prefered MIME media type # sub REST_media_type { my ($self) = @_; return $self->{REST_my_media_type}; } # REST_route # Add an entry to the dispatch table # sub REST_route { my $self = shift; my %params = ( RUN_MODE => $self->start_mode, REQUEST_METHOD => 'GET', MEDIA_TYPES => ['*/*'], FUNCTION => [$self->start_mode()], @_, ); foreach my $type (@{$params{MEDIA_TYPES}}) { $self->{REST_dispatch_table}->{$params{RUN_MODE}}-> {$params{REQUEST_METHOD}}->{$type} = $params{FUNCTION}; } } 1;
=head1 NAME CGI::Application::Plugin::REST - Helps implement RESTful architecture +in CGI applications =head1 VERSION This documentation refers to CGI::Application::Plugin::REST version 0. +8 =head1 SYNOPSIS in your CGI::Application derived module: use CGI::Application::Plugin::REST; sub setup { # or cgiapp_init $self->REST_route( RUN_MODE => 'widgets', REQUEST_METHOD => 'GET', MEDIA_TYPES => ['application/xhtml+xml', 'text/html', 'text/plain', ], FUNCTION => ['get_widget', 'product_number', ], ); $self->REST_route( RUN_MODE => 'widgets', REQUEST_METHOD => 'POST', MEDIA_TYPES => ['x-application/widget-descriptions'], FUNCTION => ['add_widget'], ); $self->REST_route( RUN_MODE => 'widgets', REQUEST_METHOD => 'PUT', MEDIA_TYPES => ['x-application/widget-descriptions',], FUNCTION => ['update_widget', 'product_number', ], ); $self->REST_route( RUN_MODE => 'widgets', REQUEST_METHOD => 'DELETE', FUNCTION => ['remove_widget', 'product_number', ], ); } sub get_widget { my ($self, $params) = @_; unless (my_validation_function($params->{product_number})) { $self->REST_error('404', 'Invalid product_number'); } my $widget = $widgets[$params->{product_number}]; if ($self->REST_media_type eq 'text/plain') { return $self->plain_output($widget); } return $self->fancy_output($widget); } etc. A typical URI might look like: http://www.example.com/index.cgi/widgets/product_number=12455 =head1 DESCRIPTION REST stands for REpresentational State Transfer. It is an architectur +e for web applications that tries to leverage the existing infrastructure of + the World Wide Web such as URIs. MIME media types and HTTP instead of buil +ding up protocols and functions on top of them. If you use L<CGI::Application>, this plugin will help you create a RES +Tful (that's the term for "using REST") architecture by abstracting out a l +ot of the busy work needed to make it happen. =head1 METHODS =over 4 =item B<REST_route> This is the main function imported by the plugin. You give it a hashr +ef of options which will be used to create a dispatch table which will match + URIs to functions in your L<CGI::Application> derived module via a hook in I<cgiapp_prerun>. The options are: =over 4 =item * I<RUN_MODE> Like a L<CGI::Application> run mode this is a part of a URL (if you ar +e using the path_info variant of C<CGI::Application::mode_param> or a CGI para +meter (if you are not) which will be mapped to one or more functions. It sh +ould not be a 'real' run mode as specified in C<CGI::Application::run_modes +> because this package will create a stub function to handle it and then call th +e FUNCTION specified below. Defaults to your start run mode as specified by C<CGI::Application::st +art_mode>. =item * I<REQUEST_METHOD> An HTTP verb. 'DELETE', 'GET', 'HEAD', 'POST', and 'PUT' are the only + ones which are treated specially but these are typically, all you need for +a RESTful web service. Defaults to 'GET'. =item * I<MEDIA_TYPES> An arrayref of MIME media types which we want to accept as input or ou +tput for a particular function. This plugin will take care of determining whic +h is the most suitable type based on the C<Accept:> HTTP header (for POST a +nd PUT) or the C<Content-Type:> HTTP header (for GET and HEAD.) DELETE doesn' +t care about MIME media types. Defaults to '*/*' which means any type. =item * I<FUNCTION> An arrayref. The first element is a function to be called. It should + be a method in your L<CGI::Application> derived module. The other elements + are keys in a hashref whose values are the equivalently named CGI paramete +rs sent to the script and passed to that function. It is your job to return o +utput from the function with the proper MIME media type and HTTP status code +. If the function dies at any point, it will be trapped and your applica +tions error run mode as defined by C<CGI::Application::error_mode> will be c +alled. Defaults to the function handled by your start run mode as specified b +y C<CGI::Application::start_mode> with no additional arguments. =back =item B<REST_error> This is a helper function which by default takes two arguments, an HTT +P status code and an error message. It adds an C<Status:> HTTP header to the o +utput and then C<die>s with the code and message. This in turn will be trapped +and your applications error run mode as defined by C<CGI::Application::err +or_mode> will be called. You can override this method in your application if you want different + behavior, =item B<REST_media_type> This is a helper function that just returns the preferred MIME media t +ype for input or output or C<undef> if it hasn't been specified. =back =head1 DIAGNOSTICS As well as the calls you make, C<REST_error> will be called by the pac +kage itself in certain circumstances. Here is a list along with status cod +es and messages. =over 4 =item * 403 Function doesn't exist The I<FUNCTION> that you wanted to call from C<REST_route> for this ru +n_mode doesn't exist in your application. =item * 405 Method Not Allowed The I<REQUEST_METHOD> being used to invoke this run_mode isn't defined + by C<REST_route>. =item * 415 Unsupported media type The requested MIME media type is not one of the I<MEDIA_TYPES> defined for this run_mode by C<REST_route>. =item * 500 Application error The I<FUNCTION> that has been called for this run_mode C<die>'d somewh +ere. =head1 BUGS This package has not been tested with modperl, fastCGI or indeed anyth +ing other than a standard CGI environment. You ought to be able to use URIs like this: http://www.example.com/index.cgi/widgets/12455 You ought to be able to override the preferred MIME type with i.e. a C +GI parameter. Maybe I should have just built upon L<CGI::Application::Dispatch> addi +ng any missing bits rather than creating a brand new module. =head1 SEE ALSO =over 4 =item * L<CGI::Application>: The application framework this module plugs into. =item * L<CGI::Application::Dispatch>: A L<CGI::Application> subclass that also does URI based function dispa +tch and a lot more. (Though it is currently doesn't handle MIME media types.) +If you find you are running into limitations with this module, you should loo +k at L<CGI::Application::Dispatch>. =item * L<http://www.ics.uci.edu/~fielding/pubs/dissertation/top.htm>: Roy Fieldings' doctoral thesis in which the term REST was first define +d. =item * L<http://www.xml.com/pub/at/34> "The Restful Web" columns by Joe Gregorio have been very useful to me +in understanding the ins and outs of REST. =back =head1 AUTHOR Jaldhar H. Vyas E<lt>jaldhar@braincells.comE<gt> =head1 COPYRIGHT AND LICENSE Copyright (C) 2006, Consolidated Braincells Inc. All rights reserved, This module is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. See L<perlartistic> This program is distributed in the hope that it will be useful, but WI +THOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

--
જલધર