| Catalyst-Plugin-AtomPP documentation | Contained in the Catalyst-Plugin-AtomPP distribution. |
Catalyst::Plugin::AtomPP - Dispatch AtomPP methods with Catalyst.
use Catalyst qw/AtomPP/;
sub entry : Local {
my ($self, $c) = @_;
$c->atom; # dispatch AtomPP methods.
}
sub create_entry : Remote {
my ($self, $c, $entry) = @_;
# $entry is XML::Atom Object from Request content
...
}
sub retrieve_entry : Remote {
my ($self, $c) = @_;
...
}
sub update_entry : Remote {
...
}
sub delete_entry : Remote {
...
}
This plugin allows you to dispatch AtomPP methods with Catalyst.
Require other authentication plugin, if needed. (Authentication::CDBI::Basic, WSSE, or so)
Daisuke Murase, <typester@cpan.org>
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Catalyst-Plugin-AtomPP documentation | Contained in the Catalyst-Plugin-AtomPP distribution. |
package Catalyst::Plugin::AtomPP; use strict; use Catalyst::Utils; use XML::Atom; use XML::Atom::Entry; our $VERSION = '0.04';
sub atom { my $c = shift; my $class = caller(0); (my $method = $c->req->action) =~ s!.*/!!; my %prefixes = ( POST => 'create_', GET => 'retrieve_', PUT => 'update_', DELETE => 'delete_', ); if (my $prefix = $prefixes{$c->req->method}) { $method = $prefix.$method; } else { $c->log->debug(qq!Unsupported Method "@{[$c->req->method]}" called!); $c->res->status(501); return; } $c->log->debug("Method: $method"); if (my $code = $class->can($method)) { my ($pp, $res); for my $attr (@{Catalyst::Utils::attrs($code)}) { $pp++ if $attr eq 'Remote'; } if ($pp) { my $content = $c->req->body; my $entry; $entry = XML::Atom::Entry->new(\$content) if $content; if ($c->req->body and !$entry) { $c->log->debug("Request body is not well-formed."); $c->res->status(415); } else { $class = $c->components->{$class} || $class; my @args = @{$c->req->args}; $c->req->args([$entry]) if $entry; $c->actions->{reverse}->{$code} ||= "$class->$method"; $c->state($c->execute($class, $code)); $c->res->content_type('application/xml; charset=utf-8'); $c->res->body($c->state); $c->req->args(\@args); } } else { $c->log->debug(qq!Method "$method" has no Atom attribute!); $c->res->status(501); } } }
1;