view release on metacpan or  search on metacpan

lib/CGI/Application/Plugin/REST.pm  view on Meta::CPAN

package CGI::Application::Plugin::REST;

use warnings;
use strict;
use Carp qw( croak );
use English qw/ -no_match_vars /;
use REST::Utils qw/ media_type request_method /;

=head1 VERSION

This document describes CGI::Application::Plugin::REST Version 0.3

=cut

our $VERSION = '0.3';

our @EXPORT_OK =
  qw/ rest_error_mode rest_param rest_resource rest_route rest_route_info
  rest_route_prefix /;

our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] );

=head1 DESCRIPTION

REST stands for REpresentational State Transfer. It is an architecture 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 building up
protocols and functions on top of them.

This plugin contains a number of functions to support the various REST
concepts. They try to use existing L<CGI::Application|CGI::Application> functionality
wherever possible.

C<use>'ing this plugin will intercept L<CGI::Application|CGI::Application>'s standard dispatch
mechanism.  Instead of being selected based on a query parameter like C<rm>,
the run mode will be determined by comparing URI patterns defined in your app
with the L<rest_route|rest_route()> method.  (Referred from here on, as "routes".)
Optionally, specific HTTP methods or MIME media types can be defined in a
route too.  One by one, each entry in the reverse asciibetically sorted table
of defined routes is compared to the incoming HTTP request and the first
successful match is selected.  The run mode mapped to that route is then
called.

This is done via overriding L<CGI::Application|CGI::Application>'s C<mode_param()> function so
it should be compatible with other L<CGI::Application|CGI::Application> plugins.

=head2 DevPopup Support

If you are using L<C::A::P::DevPopup|CGI::Application::Plugin::DevPopup> (i.e. the environment
variable C<CAP_DEVPOPUP_EXEC> is set,) C<use>'ing this module will register a
callback which will add debug information about the current route (See L<rest_route_info|rest_route_info()>),
parameters (See L<rest_param|rest_param()>) etc.

=head1 FUNCTIONS

The following functions are available.  None of them are exported by default.
You can use the C<:all> tag to import all public functions.

=cut

# Plug in to CGI::Application and setup our callbacks
#
sub import {
    my $caller = scalar caller;

    $caller->add_callback(
        'init',
        sub {
            my ($self) = @_;
            $self->mode_param( \&_rest_dispatch );

            return;
        }
    );
    if ( exists $ENV{'CAP_DEVPOPUP_EXEC'} ) {
        $caller->add_callback( 'devpopup_report', \&_rest_devpopup );
    }
    goto &Exporter::import;
}

# Callback for CGI::Application::Plugin::DevPopup which provides debug info.
#
sub _rest_devpopup {
    my ( $self, $outputref ) = @_;

    my $report = "<table>\n";
    foreach my $key ( sort keys %{ $self->{'__r_params'} } ) {
        my $name = $key;
        $name =~ s/_/ /gmsx;
        $report .= join q{},
          (
            "<tr><td>$name: </td>",        '<td colspan="2">',
            $self->{'__r_params'}->{$key}, "</td></tr>\n"
          );
    }

    # This bit is complicated but necessary as rest_param needs a
    # nested table.
    my @params = rest_param($self);
    my $rows   = scalar @params;
    $report .= qq{<tr><td rowspan="$rows">parameters: </td>};
    foreach my $param (@params) {
        if ( $param ne $params[0] ) {
            $report .= '<tr>';
        }
        $report .= join q{},
          (
            qq{<td>$param: </td><td>},
            rest_param( $self, $param ),
            "</td></tr>\n"
          );
    }
    $report .= "</table>\n";

    $self->devpopup->add_report(
        title   => 'CGI::Application::Plugin::REST',
        summary => 'Information on the current REST dispatch',
        report  => $report,
    );

    return;