-Thu 11 Apr 2012 20:20:00 BST - Release 1.07
- Don't serialize if a view is explicitly set.
-
- If the controller sets the view in $c->stash->{current_view} or
- $c->stash->{current_view_instance}, then it is explicitly requesting a
- certain kind of serialization and C::A::Serialize shouldn't override
- that.
-
- Remove Storable and FreezeThaw from the list
- of serialization methods offered by default, and
- from the docs - they're totally unsafe :/
-
-Tue 11 Dec 2012 22:04:00 GMT - Release 1.06
- Sort list of allowed methods. RT#81825
-
-Mon 2 Jul 2012 20:13:00 BST - Release 1.05
- Bugfix get_allowed_methods list:
- * include HEAD
- * remove "not_implemented"
-
-Sat 30 Jun 2012 10:25:00 BST - Release 1.04
- Bugfix to _dispatch_rest_method
-
-Wed 28 Jun 2012 00:40:00 BST - Release 1.03
- Expose _get_allowed_methods to the API (wreis)
-
- Fix default OPTIONS handler: As the ->body is defined, then serialization
- won't happen and we don't get wrong responses. (wreis)
-
- Add default HEAD handler: auto dispatches to _GET method if it exists (wreis)
-
-Tue 5 Jun 2012 22:23:00 BST - Release 1.02
- Fix forwarded REST methods, e.g. foo_GET to be more
- correctly displayed as a forward in the stats info.
-
- Make public response building methods for errors
- _unsupported_media_type and _serialize_bad_request which
- can be extended from an action-role to return custom
- error response.
-
-Tue 29 May 2012 20:19:00 BST - Release 1.01
- Add Catalyst::Action::Deserialize::JSON::XS
-
- Fix JSON::XS useage to depend on JSON.pm v2.0, and rely on the
- fact that can be backed by XS code, by explicitly setting
- $ENV{'PERL_JSON_BACKEND'} = 2
-
-Fri 13 Apr 2012 09:31:00 BST - Release 1.00
- Repack without auto_include to stop Module::Install inlining
- Test::More without Test::Builder. RT#76524
-
-Tue 28 Feb 2012 09:09:00 GMT - Release 0.99
- Repack with new Module::Install to stop depending on an unnecessary
- ExtUtils::MakeMaker version.
-
-Tue 21 Feb 2012 11:40:00 GMT - Release 0.98
- More fixes as per last release.
-
-Tue 21 Feb 2012 09:58:00 GMT - Release 0.97
- Fix test with latest Catalyst version which passes _log into
- requests.
-
-Mon 20 Jan 2012 11:22:00 GMT - Release 0.96
- Added fix for RT 63537 (from Gerv) and tests to check it.
-
-Wed 04 Jan 2012 19:34:00 GMT - Release 0.95
- Fix regex for JSONP parameter name to be able to include the . character
- in Catalyst::Action::Serialize::JSONP. RT#73741
-
- Add optional location parameter to status_accepted handler. RT#73691 (ghenry)
-
-Fri 09 Dec 2011 08:35:00 GMT - Release 0.94
- Add 403 Forbidden and 302 Not Found status methods to
- Catalyst::Controller::REST (Caleb Cushing)
-
-Wed 12 Oct 2011 11:37:00 CDT - Release 0.93
- Add a "Callback" serializer/deserializer to allow for more customization in
- how the REST data is parsed/generated (bphillips)
-
-Sat 01 Oct 2011 11:04:00 BST - Release 0.92
- Add a Catalyst::Action::DeserializeMultiPart, allowing one part of a multipart
- request to be deserialized as the REST data (allowing other parts to be used for
- file uploads, for example) (bphillips)
-
-Thu 04 Aug 2011 14:37:21 CEST - Release 0.91
- For the deserialization action class, make the HTTP methods it operates on
- configurable on a per-action level (plu, rafl).
-
-Fri 25 Feb 2011 13:56:00 GMT - Release 0.90
- Remove test which is no longer applicable and fails in the latest Catalyst
- release.
-
-Mon 24 Jan 2011 21:57:42 GMT - Release 0.89
- All classes are now made immutable. (Dave Rolsky)
-
- Added a Catalyst::Action::REST::ForBrowsers class. This will try to dispatch
- GET requests to a foo_GET_html method before trying foo_GET. (Dave Rolsky)
-
-Tue 11 Jan 2011 23:07:00 GMT - Release 0.88
- Fix documentation for overriding Serialize and Deserialize actions
- in Catalyst::Controller::REST.
-
- Avoid warning with empty response bodies and new Catalyst version
- (>= 5.80030)
-
- Returning a body of '' is now possible - Catalyst::Action::Serialize
- acts like Catalyst::Action::RenderView (>= 0.16) by using the has_body
- predicate in Catalyst::Response (>= 5.80030)
-
-Wed 3 Nov 2010 19:46:00 GMT - Release 0.87
-
- Fix Request class role when used with new Moose and other request
- class roles.
-
-Wed 1 Sept 2010 23:14:00 BST - Release 0.86
-
- Add rest_serializer_json_options config key useable to set options
- like relaxed => 1 to be passed to the JSON serializer (Ton Voon)
-
- Make Data::Dumper unserializer safer by using a Safe compartment (Ton Voon)
-
-Thu 13 May 2010 10:09:19 CEST - Release 0.85
-
- Make Catalyst::Action::Serialize::View return directly rather than serializing
- a response for 3XX status codes. This stops back-compat breakage from the
- previous change (in 0.84), whilst also allowing actual data serializers
- to still handle 3XX.
-
- Fix docs in Catalyst::TraitFor::Request::REST::ForBrowsers. (RT#54983)
-
-Thu 6 May 2010 09:27:56 BST - Release 0.84
- Revert always using a trait rather than Catalyst::Request::REST to improve
- debug messages.
-
- Add a status_multiple_choices helper method to the Controller base class.
-
- Allow 3XX responses to be serialized.
-
-Mon 8 Feb 2010 22:17:12 GMT - Release 0.83
- Make it possible to deserialize a request with a DELETE method. This probably
- breaks 'strict' REST guidelines, but is useful for being able to delete multiple
- resources from a single call by providing a batch delete method.
-
- Remove JSONP from the list of default serializers (RT#54336)
-
- Fix MANIFEST (RT#54408)
-
-Thu 4 Feb 2010 22:31:57 GMT - Release 0.82
-
- Integrated Catalyst::Request::REST::ForBrowsers as
- Catalyst::TraitFor::Request::ForBrowsers. (Dave Rolsky)
-
- Clarified docs so that they encourage the use of the request traits, rather
- than using Catalyst::Request::REST. (Dave Rolsky)
-
- When Catalyst::Action::REST or Controller::REST automatically add the trait,
- your request class will no longer end up getting set to
- Catalyst::Request::REST. Instead, creates an anon class with the appropriate
- role. (Dave Rolsky)
-
- Shut up log output from the tests. (Dave Rolsky)
-
- Added a $VERSION to every module, mostly to make sure that when people
- install Catalyst::Request::REST::ForBrowsers, they get the version in this
- distro. (Dave Rolsky)
-
- Change Catalyst::Action::Serialize, Catalyst::Action::Deserialize and
- Catalyst::Action::SerializeBase to be more Moose like.
-
- Fix JSON and JSON::XS to encode_blessed. (fREW)
-
- Fix Catalyst::Action::Serialize to use objects instead of classes. (fREW)
-
- Fix doc nits. (RT#53780)
-
-Thu 14 Jan 20:56:00 GMT 2010 - Release 0.81
-
- Add a JSONP serialization type.
-
-Sat 19 Dec 14:54:00 GMT 2009 - Release 0.80
-
- Convert all classes to Moose
-
- Change Catalyst::Request::REST to be a mostly empty class, with
- all the functionality in Catalyst::TraitFor::Request::REST
-
- Simplify _get_allowed_methods method (aristotle)
-
- Rework serializer return so that serializers throw an exception in
- the case of issues serializing the data (hobbs).
-
-Fri 11 Dec 01:08:00 GMT 2009 - Release 0.79
-
- Cope with invalid (missing required q parameter) header like:
- application/json; charset="utf-8"
-
- Fix documentation to not mention deprecated things and generally be
- in better style.
-
- Make author information consistant and only in one module.
-
-Mon 28 Sep 15:01:03 BST 2009 - Release 0.78
-
- Require Moose for the tests (RT#50066).
-
-Thu 27 Aug 02:21:09 BST 2009 - Release 0.77
-
- Allow dispatching to Catalyst Actions, for use with ActionClasses
- etc - fREW
-
- Fix test if CATALYST_DEBUG environment variable is set
-
-Fri Aug 21 21:20:52 BST 2009 - Release 0.76
-
- Added two new status response helpers (202 no content and 410 gone),
- and tests - Franck Cuny
-
-Mon Aug 17 14:07:41 BST 2009 - Release 0.75
-
- Fix optional test failures in catalyst-action-serialize-accept.t
-
- Added a serializer for JSON::XS
-
- Made test independent of YAML::Syck bugs (dandv)
-
-Wed Jul 22 23:49:16 BST 2009 (t0m) - Release 0.74
-
- Switch from NEXT to MRO::Compat (agladdish).
-
- Add display of additional REST actions in the stats, and also fix a warning
- in Catalyst 5.80 when you forward to another action from inside an
- action_FOO method (as it was confusing the stats).
-
- POD fixes
-
- Catalyst::Action::REST no longer @ISA Catalyst or Catalyst::Controller.
-
- Change constructor to call next::method instead of SUPER::
-
- Change method used to find the application class to be more correct
-
-Sat Jun 27 20:20:09 EDT 2009 (hdp) - Release 0.73
- Packaging fixes
-
-Thu Jun 25 14:52:29 EDT 2009 (hdp) - Release 0.72
- Refresh Module::Install
-
-Sat Mar 28 09:16:09 PDT 2009 (hdp) - Release 0.71
- Fix RT#44641, missing documented 'end' action
-
-Fri Mar 27 23:21:17 PDT 2009 (hdp) - Release 0.70
- Tests that use JSON were either not checking for the version or checking in a
- way that was a syntax error.
-
-Thu Mar 26 14:16:03 PDT 2009 (hdp) - Release 0.69
- Fix RT#32342, deprecated config loses default map (hdp)
- Fix broken insertion of Catalyst::Request::REST for Action::REST (jshirley)
-
-Wed Mar 25 22:33:38 PDT 2009 (hdp) - Release 0.68
- Remove prompt for ancient and deprecated Data::Denter from Makefile.PL
- Remove Data::Dump, which was entirely unused
- Stop tests from dying with Catalyst 5.80
-
-Wed Mar 25 21:59:59 PDT 2009 (hdp) - Release 0.67
- (no changes from 0.67_01)
-
-Wed Mar 25 09:36:00 PDT 2009 (hdp) - Release 0.67_01
- Fix RT#43840, improper app-level config handling
- Fix RT#42859, 'wrong' Catalyst dependency
- Fix RT#42025, stepping on custom request classes
-
-Wed Aug 20 10:42:00 PST 2008 (jshirley) - Release 0.65
- Fully revamped tests to work without any JSON support
- Final removal of JSON::Syck
- Special thanks to jgoulah for helping test this release
-
-Wed Aug 13 08:55:00 PST 2008 (jshirley) - Release 0.64
- New dist to fix issue with Module::Install
-
-Wed Jul 09 11:16:00 PST 2008 (jshirley) - Release 0.63
- Changing from JSON::Syck to JSON/JSON::XS
- Refactored tests to be more applicable to current state of affairs
-
-Wed Jul 02 07:53:00 PST 2008 (jshirley) - Release 0.62
- Reshipping with current Module::Install included due to error reports
- about failed installs
-
-
-Mon Jun 30 12:28:00 PST 2008 (jshirley) - Release 0.61
- Support official application/json and carp about text/x-json
- Accepted patch from Luke Saunders for processing all accepted content types
-
-Thu Jan 3 17:23:58 PST 2008 (adam) - Release 0.60
- Updated my contact information.
- Prepped for release.
-
-Thu Jan 3 19:42:16 EST 2008
- Fixed RT#30498 - REST controller references Catalyst without
- loading it first.
- Fixed RT#32042 - Import of Params::Validate :all plays badly
- with subclasses that have their own validate()
- Fixed RT#30456 - Debug messages print even with debugging disabled
-
-Thu Jan 3 08:54:09 PST 2008
- Fixed an issue where YAML::Syck versions 0.92 require $c->request->body to
- be stringified
-
-Fri Dec 21 15:23:46 EDT 2007
- Updated the configuration specifiers to operate more in line with the way
- Catalyst expects. Most notably component based configuration through
- "Controller::RestClass" now works. "serialize" at the top level simply
- is suggested defaults that all REST classes inherit.
-
-Wed Jul 04 11:17:20 EDT 2007
- Fixed 'default' serializer to set a valid Content-Type: header. Fixes
- RT ticket 27949. Note that behavior has changed -- the default
- serializer must now be specified as a content-type, not as a plugin
- name. (dmo@roaringpenguin.com)
-
-Thu May 24 14:01:06 PDT 2007 (adam) - Release 0.41
- Moved a bogus $self->class to $c->component($self->class)
-
-Fri Mar 9 14:13:29 PST 2007 (adam) - Release 0.40
- Refactored the Content-Type negotiation to live in Catalyst::Request::REST. (drolsky)
- Added some useful debugging. (drolsky)
- Added a View serializer/deserializer, which simply calls the correct
- Catalyst view. ('text/html' => [ 'View', 'TT' ]) (claco, adam)
-
-Wed Dec 6 00:45:02 PST 2006 (adam) - Release 0.31
- Fixed a bug where we would report a blank content-type negotiation.
- Added Data::Dump as a dependency.
-
-Tue Dec 5 13:02:08 PST 2006 (adam)
- Made the YAML::HTML view automatically append content-type=text/html on
- the resulting URLs.
-
-Sun Dec 3 12:24:16 PST 2006 (adam) - Release 0.30
- Updated the Makefile to support optional installation of the different
- Serialization formats.
- Renamed some of the test cases, since the execution order doesn't
- matter.
- Fixed things so that not having a Serialization module returns 415.
- Fixed things so that failure to Deserialize sends the proper status.
- Refactored the Plugin loading to Catalyst::Action::SerializeBase.
- Updated the Documentation.
- Added a whole raft of serializers. (JSON, all the Data::Serializer
- supported ones, and XML::Simple)
- Added test cases.
-
-Thu Nov 30 23:51:04 PST 2006 (adam)
- Refactored the Catalyst::Action::REST dispatch, so that the default
- method is called before any _METHOD handlers. In addition, moved
- the 405 Not Implemented handler to be foo_not_implemented, instead
- of the default sub. (daisuke++ pointed out the inconsistency and
- provided a patch, and I added the foo_not_implemented support)
-
- Added in automated OPTIONS handler, which constructs the allow
- header for you, just like the 405 handler. Can be overridden
- with a normal _METHOD sub.
-
- Refactored Test::Rest, so that it uses closures to create the
- very similar $test->method() subs.
-
- Added tests for Catalyst::Action::REST.
-
-Thu Nov 30 17:14:51 PST 2006 (adam) - Release 0.2
- Added documentation patch from Daisuke Maki (daisuke@endeworks.jp)
- Added dependency patch from Daisuke Maki (daisuke@endeworks.jp)
-
-Sun Nov 19 16:24:20 PST 2006 (adam) - Release 0.1
- Added status_accepted (Code 202)
- Added a first pass at documentation.
-
-Mon Oct 16 14:48:54 PDT 2006 (adam)
- Added in Test Suite
- Created Catalyst::Action::Serialize and Catalyst::Action::Deserialize
- Added Data::Serializer actions
- Added status_created helper method
-
-Wed Oct 18 17:29:07 PDT 2006 (adam)
- Added more status_ helpers
-
-Thu Oct 19 16:04:33 PDT 2006 (adam)
- Converted error helpers to return an object instead of plain-text. It's
- a more consistent model than a text/plain error message.
- Added logging to 4xx status handlers
+Thu 11 Apr 2012 15:00:00 CST - Release 1.08
+ Extract Catalyst::Action::(De)serialize::Data::Serializer into it's own dist
+ It is presumed that this module is rarely used and it is known to be brittle.
+ Let's not penalize the vast majority of users for the vanishingly few who use
+ this crack.
perl_version '5.8.1';
-name 'Catalyst-Action-REST';
-all_from 'lib/Catalyst/Action/REST.pm';
+name 'Catalyst-Action-Serialize-Data-Serializer';
+all_from 'lib/Catalyst/Action/Serialize/Data/Serializer.pm';
+requires('Catalyst::Action::REST' => '1.08');
requires 'Moose' => '1.03';
requires 'namespace::autoclean';
requires('Catalyst::Runtime' => '5.80030');
-requires('Params::Validate' => '0.76');
-requires('YAML::Syck' => '0.67');
-requires('HTML::Parser' => undef);
-requires('Module::Pluggable::Object' => undef);
-requires('LWP::UserAgent' => '2.033');
requires('Data::Serializer' => '0.36');
-requires('Class::Inspector' => '1.13');
-requires('URI::Find' => undef);
-requires('MRO::Compat' => '0.10');
-requires 'namespace::autoclean';
test_requires 'Test::More' => '0.88';
author_requires 'Test::Pod' => 1.14;
author_tests 'xt/';
-feature 'JSON (application/json) support',
- -default => 0,
- 'JSON' => '2.12',
- 'JSON::XS' => '2.2222';
-
-author_requires 'JSON' => '2.12';
-author_requires 'JSON::XS' => '2.2222';
-
-feature 'Data::Taxi (text/x-data-taxi) support (deprecated)',
- -default => 0,
- 'Data::Taxi' => undef;
-
-author_requires 'Data::Taxi';
-
-feature 'Config::General (text/x-config-general) support',
- -default => 0,
- 'Config::General' => undef;
-author_requires 'Config::General';
-
-feature 'PHP::Serialization (text/x-php-serialization) support',
- -default => 0,
- 'PHP::Serialization' => undef;
-author_requires 'PHP::Serialization';
-
-feature 'FreezeThaw (application/x-freezethaw) support',
- -default => 0,
- 'FreezeThaw' => undef;
-author_requires 'FreezeThaw';
-
-feature 'XML::Simple (text/xml) support',
- -default => 0,
- 'XML::Simple' => undef;
-author_requires 'XML::Simple';
-
auto_install;
if ($Module::Install::AUTHOR) {
- system("pod2text lib/Catalyst/Action/REST.pm > README")
+ system("pod2text lib/Catalyst/Action/Serialize/Data/Serializer.pm > README")
and die $!;
}
-repository 'git://git.shadowcat.co.uk/catagits/Catalyst-Action-REST.git';
+repository
+ 'git://git.shadowcat.co.uk/catagits/Catalyst-Action-Serialize-Data-Serializer.git';
add_metadata( x_authority => 'cpan:BOBTFISH' );
NAME
- Catalyst::Action::REST - Automated REST Method Dispatching
+ Catalyst::Action::Serialize::Data::Serializer - Serialize with
+ Data::Serializer
SYNOPSIS
- sub foo :Local :ActionClass('REST') {
- ... do setup for HTTP method specific handlers ...
- }
+ package MyApp::Controller::Foo;
- sub foo_GET {
- ... do something for GET requests ...
- }
+ use Moose;
+ use namespace::autoclean;
- # alternatively use an Action
- sub foo_PUT : Action {
- ... do something for PUT requests ...
- }
+ BEGIN { extends 'Catalyst::Controller' }
+
+ __PACKAGE__->config(
+ 'default' => 'text/x-yaml',
+ 'stash_key' => 'rest',
+ 'map' => {
+ 'text/x-yaml' => 'YAML',
+ 'application/json' => 'JSON',
+ 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+ },
+ );
DESCRIPTION
- This Action handles doing automatic method dispatching for REST
- requests. It takes a normal Catalyst action, and changes the dispatch to
- append an underscore and method name. First it will try dispatching to
- an action with the generated name, and failing that it will try to
- dispatch to a regular method.
-
- For example, in the synopsis above, calling GET on "/foo" would result
- in the foo_GET method being dispatched.
-
- If a method is requested that is not implemented, this action will
- return a status 405 (Method Not Found). It will populate the "Allow"
- header with the list of implemented request methods. You can override
- this behavior by implementing a custom 405 handler like so:
-
- sub foo_not_implemented {
- ... handle not implemented methods ...
- }
-
- If you do not provide an _OPTIONS subroutine, we will automatically
- respond with a 200 OK. The "Allow" header will be populated with the
- list of implemented request methods. If you do not provide an _HEAD
- either, we will auto dispatch to the _GET one in case it exists.
-
- It is likely that you really want to look at Catalyst::Controller::REST,
- which brings this class together with automatic Serialization of
- requests and responses.
-
- When you use this module, it adds the Catalyst::TraitFor::Request::REST
- role to your request class.
-
-METHODS
- dispatch
- This method overrides the default dispatch mechanism to the
- re-dispatching mechanism described above.
-
-SEE ALSO
- You likely want to look at Catalyst::Controller::REST, which implements
- a sensible set of defaults for a controller doing REST.
-
- This class automatically adds the Catalyst::TraitFor::Request::REST 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 Catalyst::TraitFor::Request::REST::ForBrowsers
- instead.
-
- Catalyst::Action::Serialize, Catalyst::Action::Deserialize
-
-TROUBLESHOOTING
- Q: I'm getting a "415 Unsupported Media Type" error. What gives?!
- A: Most likely, you haven't set Content-type equal to
- "application/json", or one of the accepted return formats. You can
- do this by setting it in your query accepted return formats. You can
- do this by setting it in your query string thusly:
- "?content-type=application%2Fjson (where %2F == / uri escaped)."
-
- NOTE Apache will refuse %2F unless configured otherwise. Make sure
- "AllowEncodedSlashes On" is in your httpd.conf file in order for
- this to run smoothly.
+ This module implements a serializer for use with "Data::Dumper" and
+ others. It was factored out of Catalyst::Action::REST because it is
+ unlikely to be widely used and tends to break tests, be insecure, and is
+ genreally weird. Use at your own risk.
AUTHOR
Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and
Wallace Reis <wreis@cpan.org>
COPYRIGHT
- Copyright (c) 2006-2012 the above named AUTHOR and CONTRIBUTORS
+ Copyright (c) 2006-2013 the above named AUTHOR and CONTRIBUTORS
LICENSE
You may distribute this code under the same terms as Perl itself.
+++ /dev/null
-* Override setup_classes from Catalyst::Base, so things that use
- C::Controller:REST don't need to have ActionClass('REST') on them
-
-* More documentation of the Serialization/Deserialization process.
-
-* More Serializers!
-
-* More status methods!
-
-* More tests
-
-* Add a preference weight for what type of content to return given an
- equal weight Accept header.
\ No newline at end of file
+++ /dev/null
-package Catalyst::Action::Deserialize;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action::SerializeBase';
-use Module::Pluggable::Object;
-use MRO::Compat;
-use Moose::Util::TypeConstraints;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-has plugins => ( is => 'rw' );
-
-has deserialize_http_methods => (
- traits => ['Hash'],
- isa => do {
- my $tc = subtype as 'HashRef[Str]';
- coerce $tc, from 'ArrayRef[Str]',
- via { +{ map { ($_ => 1) } @$_ } };
- $tc;
- },
- coerce => 1,
- builder => '_build_deserialize_http_methods',
- handles => {
- deserialize_http_methods => 'keys',
- _deserialize_handles_http_method => 'exists',
- },
-);
-
-sub _build_deserialize_http_methods { [qw(POST PUT OPTIONS DELETE)] }
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- if ( !defined($c->req->data) && $self->_deserialize_handles_http_method($c->request->method) ) {
- my ( $sclass, $sarg, $content_type ) =
- $self->_load_content_plugins( 'Catalyst::Action::Deserialize',
- $controller, $c );
- return 1 unless defined($sclass);
- my $rc;
- if ( defined($sarg) ) {
- $rc = $sclass->execute( $controller, $c, $sarg );
- } else {
- $rc = $sclass->execute( $controller, $c );
- }
- if ( $rc eq "0" ) {
- return $self->unsupported_media_type( $c, $content_type );
- } elsif ( $rc ne "1" ) {
- return $self->serialize_bad_request( $c, $content_type, $rc );
- }
- }
-
- $self->maybe::next::method(@_);
-
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-=head1 NAME
-
-Catalyst::Action::Deserialize - Deserialize Data in a Request
-
-=head1 SYNOPSIS
-
- package Foo::Controller::Bar;
-
- __PACKAGE__->config(
- 'default' => 'text/x-yaml',
- 'stash_key' => 'rest',
- 'map' => {
- 'text/x-yaml' => 'YAML',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- },
- );
-
- sub begin :ActionClass('Deserialize') {}
-
-=head1 DESCRIPTION
-
-This action will deserialize HTTP POST, PUT, OPTIONS and DELETE requests.
-It assumes that the body of the HTTP Request is a serialized object.
-The serializer is selected by introspecting the requests content-type
-header.
-
-If you want deserialize any other HTTP method besides POST, PUT,
-OPTIONS and DELETE you can do this by setting the
-C<< deserialize_http_methods >> list via C<< action_args >>.
-Just modify the config in your controller and define a list of HTTP
-methods the deserialization should happen for:
-
- __PACKAGE__->config(
- action_args => {
- '*' => {
- deserialize_http_methods => [qw(POST PUT OPTIONS DELETE GET)]
- }
- }
- );
-
-See also L<Catalyst::Controller/action_args>.
-
-The specifics of deserializing each content-type is implemented as
-a plugin to L<Catalyst::Action::Deserialize>. You can see a list
-of currently implemented plugins in L<Catalyst::Controller::REST>.
-
-The results of your Deserializing will wind up in $c->req->data.
-This is done through the magic of L<Catalyst::Request::REST>.
-
-While it is common for this Action to be called globally as a
-C<begin> method, there is nothing stopping you from using it on a
-single routine:
-
- sub foo :Local :Action('Deserialize') {}
-
-Will work just fine.
-
-When you use this module, the request class will be changed to
-L<Catalyst::Request::REST>.
-
-=head1 CUSTOM ERRORS
-
-For building custom error responses when de-serialization fails, you can create
-an ActionRole (and use L<Catalyst::Controller::ActionRole> to apply it to the
-C<begin> action) which overrides C<unsupported_media_type> and/or C<_serialize_bad_request>
-methods.
-
-=head1 SEE ALSO
-
-You likely want to look at L<Catalyst::Controller::REST>, which implements
-a sensible set of defaults for a controller doing REST.
-
-L<Catalyst::Action::Serialize>, L<Catalyst::Action::REST>
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Action::Deserialize::Callback;
-
-use Moose;
-use namespace::autoclean;
-use Scalar::Util qw(openhandle);
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $callbacks ) = @_;
-
- my $rbody;
-
- # could be a string or a FH
- if ( my $body = $c->request->body ) {
- if(openhandle $body) {
- seek($body, 0, 0); # in case something has already read from it
- while ( defined( my $line = <$body> ) ) {
- $rbody .= $line;
- }
- } else {
- $rbody = $body;
- }
- }
-
- if ( $rbody ) {
- my $rdata = eval { $callbacks->{deserialize}->( $rbody, $controller, $c ) };
- if ($@) {
- return $@;
- }
- $c->request->data($rdata);
- } else {
- $c->log->debug(
- 'I would have deserialized, but there was nothing in the body!')
- if $c->debug;
- }
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
+++ /dev/null
-package Catalyst::Action::Deserialize::JSON;
-
-use Moose;
-use namespace::autoclean;
-use Scalar::Util qw(openhandle);
-
-extends 'Catalyst::Action';
-use JSON;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $test ) = @_;
-
- my $rbody;
-
- # could be a string or a FH
- if ( my $body = $c->request->body ) {
- if(openhandle $body) {
- seek($body, 0, 0); # in case something has already read from it
- while ( defined( my $line = <$body> ) ) {
- $rbody .= $line;
- }
- } else {
- $rbody = $body;
- }
- }
-
- if ( $rbody ) {
- my $json = JSON->new->utf8;
- if (my $options = $controller->{json_options}) {
- foreach my $opt (keys %$options) {
- $json->$opt( $options->{$opt} );
- }
- }
- my $rdata = eval { $json->decode( $rbody ) };
- if ($@) {
- return $@;
- }
- $c->request->data($rdata);
- } else {
- $c->log->debug(
- 'I would have deserialized, but there was nothing in the body!')
- if $c->debug;
- }
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Deserialize::JSON::XS;
-
-use Moose;
-use namespace::autoclean;
-BEGIN {
- $ENV{'PERL_JSON_BACKEND'} = 2; # Always use compiled JSON::XS
-}
-
-extends 'Catalyst::Action::Deserialize::JSON';
-use JSON::XS ();
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Deserialize::View;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Deserialize::XML::Simple;
-
-use Moose;
-use namespace::autoclean;
-use Scalar::Util qw(openhandle);
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $test ) = @_;
-
- eval {
- require XML::Simple;
- };
- if ($@) {
- $c->log->debug("Could not load XML::Simple, refusing to deserialize: $@")
- if $c->debug;
- return 0;
- }
-
- my $body = $c->request->body;
- if ($body) {
- my $xs = XML::Simple->new('ForceArray' => 0,);
- my $rdata;
- eval {
- if(openhandle $body){ # make sure we rewind the file handle
- seek($body, 0, 0); # in case something has already read from it
- }
- $rdata = $xs->XMLin( $body );
- };
- if ($@) {
- return $@;
- }
- if (exists($rdata->{'data'})) {
- $c->request->data($rdata->{'data'});
- } else {
- $c->request->data($rdata);
- }
- } else {
- $c->log->debug(
- 'I would have deserialized, but there was nothing in the body!')
- if $c->debug;
- }
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Deserialize::YAML;
-
-use Moose;
-use namespace::autoclean;
-use Scalar::Util qw(openhandle);
-
-extends 'Catalyst::Action';
-use YAML::Syck;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $test ) = @_;
-
- my $body = $c->request->body;
- if ($body) {
-
- my $rbody = '';
-
- if(openhandle $body) {
- seek($body, 0, 0); # in case something has already read from it
- while ( defined( my $line = <$body> ) ) {
- $rbody .= $line;
- }
- } else {
- $rbody = $body;
- }
-
- my $rdata;
- eval {
- $rdata = Load( $rbody );
- };
- if ($@) {
- return $@;
- }
- $c->request->data($rdata);
- } else {
- $c->log->debug(
- 'I would have deserialized, but there was nothing in the body!')
- if $c->debug;
- }
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::DeserializeMultiPart;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action::Deserialize';
-use HTTP::Body;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-our $NO_HTTP_BODY_TYPES_INITIALIZATION;
-$HTTP::Body::TYPES->{'multipart/mixed'} = 'HTTP::Body::MultiPart' unless $NO_HTTP_BODY_TYPES_INITIALIZATION;
-
-override execute => sub {
- my $self = shift;
- my ( $controller, $c ) = @_;
- if($c->request->content_type =~ m{^multipart/}i && !defined($c->request->body)){
- my $REST_part = $self->attributes->{DeserializePart} || [];
- my($REST_body) = $c->request->upload($REST_part->[0] || 'REST');
- if($REST_body){
- $c->request->_body->body( $REST_body->fh );
- $c->request->content_type( $REST_body->type );
- }
- }
- super;
-};
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-=head1 NAME
-
-Catalyst::Action::DeserializeMultiPart - Deserialize Data in a Multipart Request
-
-=head1 SYNOPSIS
-
- package Foo::Controller::Bar;
-
- __PACKAGE__->config(
- # see Catalyst::Action::Deserialize for standard config
- );
-
- sub begin :ActionClass('DeserializeMultiPart') DeserializePart('REST') {}
-
-=head1 DESCRIPTION
-
-This action will deserialize multipart HTTP POST, PUT, OPTIONS and DELETE
-requests. It is a simple extension of L<Catalyst::Action::Deserialize>
-with the exception that rather than using the entire request body (which
-may contain multiple sections), it will look for a single part in the request
-body named according to the C<DeserializePart> attribute on that action
-(defaulting to C<REST>). If a part is found under that name, it then
-proceeds to deserialize the request as normal based on the content-type
-of that individual part. If no such part is found, the request would
-be processed as if no data was sent.
-
-This module's code will only come into play if the following conditions are met:
-
-=over 4
-
-=item * The C<Content-type> of the request is C<multipart/*>
-
-=item * The request body (as returned by C<$c->request->body> is not defined
-
-=item * There is a part of the request body (as returned by C<$c->request->upload($DeserializePart)>) available
-
-=back
-
-=head1 CONFIGURING HTTP::Body
-
-By default, L<HTTP::Body> parses C<multipart/*> requests as an
-L<HTTP::Body::OctetStream>. L<HTTP::Body::OctetStream> does not separate
-out the individual parts of the request body. In order to make use of
-the individual parts, L<HTTP::Body> must be told which content types
-to map to L<HTTP::Body::MultiPart>. This module makes the assumption
-that you would like to have all C<multipart/mixed> requests parsed by
-L<HTTP::Body::MultiPart> module. This is done by a package variable
-inside L<HTTP::Body>: C<$HTTP::Body::Types> (a HASH ref).
-
-B<WARNING:> As this module modifies the behaviour of HTTP::Body globally,
-adding it to an application can have unintended consequences as multipart
-bodies will be parsed differently from before.
-
-Feel free to
-add other content-types to this hash if needed or if you would prefer
-that C<multipart/mixed> NOT be added to this hash, simply delete it
-after loading this module.
-
- # in your controller
- use Catalyst::Action::DeserializeMultiPart;
-
- delete $HTTP::Body::Types->{'multipart/mixed'};
- $HTTP::Body::Types->{'multipart/my-crazy-content-type'} = 'HTTP::Body::MultiPart';
-
-=head1 SEE ALSO
-
-This is a simple sub-class of L<Catalyst::Action::Deserialize>.
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Action::REST;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-use Class::Inspector;
-use Catalyst::Request::REST;
-use Catalyst::Controller::REST;
-
-BEGIN { require 5.008001; }
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub BUILDARGS {
- my $class = shift;
- my $config = shift;
- Catalyst::Request::REST->_insert_self_into( $config->{class} );
- return $class->SUPER::BUILDARGS($config, @_);
-}
-
-=head1 NAME
-
-Catalyst::Action::REST - Automated REST Method Dispatching
-
-=head1 SYNOPSIS
-
- sub foo :Local :ActionClass('REST') {
- ... do setup for HTTP method specific handlers ...
- }
-
- sub foo_GET {
- ... do something for GET requests ...
- }
-
- # alternatively use an Action
- sub foo_PUT : Action {
- ... do something for PUT requests ...
- }
-
-=head1 DESCRIPTION
-
-This Action handles doing automatic method dispatching for REST requests. It
-takes a normal Catalyst action, and changes the dispatch to append an
-underscore and method name. First it will try dispatching to an action with
-the generated name, and failing that it will try to dispatch to a regular
-method.
-
-For example, in the synopsis above, calling GET on "/foo" would result in
-the foo_GET method being dispatched.
-
-If a method is requested that is not implemented, this action will
-return a status 405 (Method Not Found). It will populate the "Allow" header
-with the list of implemented request methods. You can override this behavior
-by implementing a custom 405 handler like so:
-
- sub foo_not_implemented {
- ... handle not implemented methods ...
- }
-
-If you do not provide an _OPTIONS subroutine, we will automatically respond
-with a 200 OK. The "Allow" header will be populated with the list of
-implemented request methods. If you do not provide an _HEAD either, we will
-auto dispatch to the _GET one in case it exists.
-
-It is likely that you really want to look at L<Catalyst::Controller::REST>,
-which brings this class together with automatic Serialization of requests
-and responses.
-
-When you use this module, it adds the L<Catalyst::TraitFor::Request::REST>
-role to your request class.
-
-=head1 METHODS
-
-=over 4
-
-=item dispatch
-
-This method overrides the default dispatch mechanism to the re-dispatching
-mechanism described above.
-
-=cut
-
-sub dispatch {
- my $self = shift;
- my $c = shift;
-
- 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) ) {
- return $c->forward( $code, $req->args ); # Forward to foo_GET if it's an action
- }
- elsif ($code = $controller->can($rest_method)) {
- $name = $rest_method; # Stash name and code to run 'foo_GET' like an action below.
- }
-
- # Generic handling for foo_*
- if (!$code) {
- 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 ( $http_method, $action_name ) = ( $rest_method, $self->name );
- $http_method =~ s{\Q$action_name\E\_}{};
- my $respond = ($code_action->{$http_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;
- my @name = split m{/}, $self->reverse;
- $name[-1] = $name;
- local $self->{reverse} = "-> " . join('/', @name);
-
- $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 = {
- map { /^$name\_(.+)$/ ? ( $1 => 1 ) : () }
- @{ Class::Inspector->methods($class) }
- };
- $methods->{'HEAD'} = 1 if $methods->{'GET'};
- delete $methods->{'not_implemented'};
- return sort keys %$methods;
-};
-
-sub _return_options {
- my ( $self, $method_name, $controller, $c) = @_;
- my @allowed = $self->get_allowed_methods($controller, $c, $method_name);
- $c->response->content_type('text/plain');
- $c->response->status(200);
- $c->response->header( 'Allow' => \@allowed );
- $c->response->body(q{});
-}
-
-sub _return_not_implemented {
- my ( $self, $method_name, $controller, $c ) = @_;
-
- my @allowed = $self->get_allowed_methods($controller, $c, $method_name);
- $c->response->content_type('text/plain');
- $c->response->status(405);
- $c->response->header( 'Allow' => \@allowed );
- $c->response->body( "Method "
- . $c->request->method
- . " not implemented for "
- . $c->uri_for( $method_name ) );
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-=back
-
-=head1 SEE ALSO
-
-You likely want to look at L<Catalyst::Controller::REST>, which implements a
-sensible set of defaults for a controller doing REST.
-
-This class automatically adds the L<Catalyst::TraitFor::Request::REST> 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<Catalyst::TraitFor::Request::REST::ForBrowsers> instead.
-
-L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>
-
-=head1 TROUBLESHOOTING
-
-=over 4
-
-=item Q: I'm getting a "415 Unsupported Media Type" error. What gives?!
-
-A: Most likely, you haven't set Content-type equal to "application/json", or
-one of the accepted return formats. You can do this by setting it in your query
-accepted return formats. You can do this by setting it in your query string
-thusly: C<< ?content-type=application%2Fjson (where %2F == / uri escaped). >>
-
-B<NOTE> Apache will refuse %2F unless configured otherwise.
-Make sure C<AllowEncodedSlashes On> is in your httpd.conf file in order
-for this to run smoothly.
-
-=back
-
-=head1 AUTHOR
-
-Adam Jacob E<lt>adam@stalecoffee.orgE<gt>, with lots of help from mst and jrockway
-
-Marchex, Inc. paid me while I developed this module. (L<http://www.marchex.com>)
-
-=head1 CONTRIBUTORS
-
-Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt>
-
-John Goulah
-
-Christopher Laco
-
-Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
-
-Hans Dieter Pearcey
-
-Brian Phillips E<lt>bphillips@cpan.orgE<gt>
-
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
-
-Luke Saunders
-
-Arthur Axel "fREW" Schmidt E<lt>frioux@gmail.comE<gt>
-
-J. Shirley E<lt>jshirley@gmail.comE<gt>
-
-Gavin Henry E<lt>ghenry@surevoip.co.ukE<gt>
-
-Gerv http://www.gerv.net/
-
-Colin Newell <colin@opusvl.com>
-
-Wallace Reis E<lt>wreis@cpan.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006-2012 the above named AUTHOR and CONTRIBUTORS
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-
+++ /dev/null
-package Catalyst::Action::REST::ForBrowsers;
-
-use Moose;
-use namespace::autoclean;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-extends 'Catalyst::Action::REST';
-use Catalyst::Request::REST::ForBrowsers;
-
-sub BUILDARGS {
- my $class = shift;
- my $config = shift;
- Catalyst::Request::REST::ForBrowsers->_insert_self_into( $config->{class} );
- return $class->SUPER::BUILDARGS( $config, @_ );
-}
-
-override dispatch => sub {
- my $self = shift;
- my $c = shift;
-
- my $req = $c->request();
-
- return super()
- unless $req->can('looks_like_browser')
- && $req->looks_like_browser()
- && uc $c->request()->method() eq 'GET';
-
- my $controller = $c->component( $self->class );
- my $rest_method = $self->name() . '_GET_html';
-
- if ( $controller->action_for($rest_method)
- || $controller->can($rest_method) ) {
-
- return $self->_dispatch_rest_method( $c, $rest_method );
- }
-
- return super();
-};
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-=head1 NAME
-
-Catalyst::Action::REST::ForBrowsers - Automated REST Method Dispatching that Accommodates Browsers
-
-=head1 SYNOPSIS
-
- sub foo :Local :ActionClass('REST::ForBrowsers') {
- ... do setup for HTTP method specific handlers ...
- }
-
- sub foo_GET : Private {
- ... do something for GET requests ...
- }
-
- sub foo_GET_html : Private {
- ... do something for GET requests from browsers ...
- }
-
- sub foo_PUT : Private {
- ... do something for PUT requests ...
- }
-
-=head1 DESCRIPTION
-
-This class subclasses L<Catalyst::Action::REST> to add an additional
-dispatching hook. If the request is a GET request I<and> the request looks
-like it comes from a browser, it tries to dispatch to a C<GET_html> method
-before trying to the C<GET> method instead. All other HTTP methods are
-dispatched in the same way.
-
-For example, in the synopsis above, calling GET on "/foo" from a browser will
-end up calling the C<foo_GET_html> method. If the request is I<not> from a
-browser, it will call C<foo_GET>.
-
-See L<Catalyst::Action::REST> for more details on dispatching details.
-
-=head1 METHODS
-
-=over 4
-
-=item dispatch
-
-This method overrides the default dispatch mechanism to the re-dispatching
-mechanism described above.
-
-=back
-
-=head1 SEE ALSO
-
-You likely want to look at L<Catalyst::Controller::REST>, which implements a
-sensible set of defaults for a controller doing REST.
-
-This class automatically adds the
-L<Catalyst::TraitFor::Request::REST::ForBrowsers> role to your request class.
-
-=head1 CONTRIBUTORS
-
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright the above named AUTHOR and CONTRIBUTORS
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Action::Serialize;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action::SerializeBase';
-use Module::Pluggable::Object;
-use MRO::Compat;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-has _encoders => (
- is => 'ro',
- isa => 'HashRef',
- default => sub { {} },
-);
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- $self->maybe::next::method(@_);
-
- return 1 if $c->req->method eq 'HEAD';
- return 1 if $c->response->has_body;
- return 1 if scalar @{ $c->error };
- return 1 if $c->response->status =~ /^(?:204)$/;
- return 1 if defined $c->stash->{current_view};
- return 1 if defined $c->stash->{current_view_instance};
-
- my ( $sclass, $sarg, $content_type ) =
- $self->_load_content_plugins( "Catalyst::Action::Serialize",
- $controller, $c );
- unless ( defined($sclass) ) {
- if ( defined($content_type) ) {
- $c->log->info("Could not find a serializer for $content_type");
- } else {
- $c->log->info(
- "Could not find a serializer for an empty content-type");
- }
- return 1;
- }
- $c->log->debug(
- "Serializing with $sclass" . ( $sarg ? " [$sarg]" : '' ) ) if $c->debug;
-
- $self->_encoders->{$sclass} ||= $sclass->new;
- my $sobj = $self->_encoders->{$sclass};
-
- my $rc;
- eval {
- if ( defined($sarg) ) {
- $rc = $sobj->execute( $controller, $c, $sarg );
- } else {
- $rc = $sobj->execute( $controller, $c );
- }
- };
- if ($@) {
- return $self->serialize_bad_request( $c, $content_type, $@ );
- } elsif (!$rc) {
- return $self->unsupported_media_type( $c, $content_type );
- }
-
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-=head1 NAME
-
-Catalyst::Action::Serialize - Serialize Data in a Response
-
-=head1 SYNOPSIS
-
- package Foo::Controller::Bar;
-
- __PACKAGE__->config(
- 'default' => 'text/x-yaml',
- 'stash_key' => 'rest',
- 'map' => {
- 'text/html' => [ 'View', 'TT', ],
- 'text/x-yaml' => 'YAML',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- }
- );
-
- sub end :ActionClass('Serialize') {}
-
-=head1 DESCRIPTION
-
-This action will serialize the body of an HTTP Response. The serializer is
-selected by introspecting the HTTP Requests content-type header.
-
-It requires that your Catalyst controller is properly configured to set up the
-mapping between Content Type's and Serialization classes.
-
-The specifics of serializing each content-type is implemented as a plugin to
-L<Catalyst::Action::Serialize>.
-
-Typically, you would use this ActionClass on your C<end> method. However,
-nothing is stopping you from choosing specific methods to Serialize:
-
- sub foo :Local :ActionClass('Serialize') {
- .. populate stash with data ..
- }
-
-When you use this module, the request class will be changed to
-L<Catalyst::Request::REST>.
-
-=head1 CONFIGURATION
-
-=head2 map
-
-Takes a hashref, mapping Content-Types to a given serializer plugin.
-
-=head2 default
-
-This is the 'fall-back' Content-Type if none of the requested or acceptable
-types is found in the L</map>. It must be an entry in the L</map>.
-
-=head2 stash_key
-
-Specifies the key of the stash entry holding the data that is to be serialized.
-So if the value is "rest", we will serialize the data under:
-
- $c->stash->{'rest'}
-
-=head2 content_type_stash_key
-
-Specifies the key of the stash entry that optionally holds an overriding
-Content-Type. If set, and if the specified stash entry has a valid value,
-then it takes priority over the requested content types.
-
-This can be useful if you want to dynamically force a particular content type,
-perhaps for debugging.
-
-=head1 HELPFUL PEOPLE
-
-Daisuke Maki pointed out that early versions of this Action did not play
-well with others, or generally behave in a way that was very consistent
-with the rest of Catalyst.
-
-=head1 CUSTOM ERRORS
-
-For building custom error responses when serialization fails, you can create
-an ActionRole (and use L<Catalyst::Controller::ActionRole> to apply it to the
-C<end> action) which overrides C<unsupported_media_type> and/or C<_serialize_bad_request>
-methods.
-
-=head1 SEE ALSO
-
-You likely want to look at L<Catalyst::Controller::REST>, which implements
-a sensible set of defaults for doing a REST controller.
-
-L<Catalyst::Action::Deserialize>, L<Catalyst::Action::REST>
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Action::Serialize::Callback;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $callbacks ) = @_;
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
- my $output = $callbacks->{serialize}->( $c->stash->{$stash_key}, $controller, $c );
- $c->response->output( $output );
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
my $stash_key = (
$controller->{'serialize'} ?
$controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
+ $controller->{'stash_key'}
) || 'rest';
my $sp = $serializer;
$sp =~ s/::/\//g;
__PACKAGE__->meta->make_immutable;
1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Action::Serialize::Data::Serializer - Serialize with Data::Serializer
+
+=head1 SYNOPSIS
+
+ package MyApp::Controller::Foo;
+
+ use Moose;
+ use namespace::autoclean;
+
+ BEGIN { extends 'Catalyst::Controller' }
+
+ __PACKAGE__->config(
+ 'default' => 'text/x-yaml',
+ 'stash_key' => 'rest',
+ 'map' => {
+ 'text/x-yaml' => 'YAML',
+ 'application/json' => 'JSON',
+ 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+ },
+ );
+
+=head1 DESCRIPTION
+
+This module implements a serializer for use with C<Data::Dumper> and others. It
+was factored out of L<Catalyst::Action::REST> because it is unlikely to be
+widely used and tends to break tests, be insecure, and is genreally weird. Use
+at your own risk.
+
+=head1 AUTHOR
+
+Adam Jacob E<lt>adam@stalecoffee.orgE<gt>, with lots of help from mst and jrockway
+
+Marchex, Inc. paid me while I developed this module. (L<http://www.marchex.com>)
+
+=head1 CONTRIBUTORS
+
+Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt>
+
+John Goulah
+
+Christopher Laco
+
+Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
+
+Hans Dieter Pearcey
+
+Brian Phillips E<lt>bphillips@cpan.orgE<gt>
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+Luke Saunders
+
+Arthur Axel "fREW" Schmidt E<lt>frioux@gmail.comE<gt>
+
+J. Shirley E<lt>jshirley@gmail.comE<gt>
+
+Gavin Henry E<lt>ghenry@surevoip.co.ukE<gt>
+
+Gerv http://www.gerv.net/
+
+Colin Newell <colin@opusvl.com>
+
+Wallace Reis E<lt>wreis@cpan.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006-2013 the above named AUTHOR and CONTRIBUTORS
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+++ /dev/null
-package Catalyst::Action::Serialize::JSON;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-use JSON ();
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-has encoder => (
- is => 'ro',
- lazy_build => 1,
-);
-
-sub _build_encoder {
- my $self = shift;
- return JSON->new->utf8->convert_blessed;
-}
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
- my $output = $self->serialize( $c->stash->{$stash_key} );
- $c->response->output( $output );
- return 1;
-}
-
-sub serialize {
- my $self = shift;
- my $data = shift;
- $self->encoder->encode( $data );
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::JSON::XS;
-
-use Moose;
-use namespace::autoclean;
-BEGIN {
- $ENV{'PERL_JSON_BACKEND'} = 2; # Always use compiled JSON::XS
-}
-
-extends 'Catalyst::Action::Serialize::JSON';
-use JSON::XS ();
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::JSONP;
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action::Serialize::JSON';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-after 'execute' => sub {
- my $self = shift;
- my ($controller, $c) = @_;
-
- my $callback_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'callback_key'} :
- $controller->{'callback_key'}
- ) || 'callback';
-
- my $callback_value = $c->req->param($callback_key);
- if ($callback_value) {
- if ($callback_value =~ /^[.\w]+$/) {
- $c->res->content_type('text/javascript');
- $c->res->output($callback_value.'('.$c->res->output().');');
- } else {
- warn 'Callback: '.$callback_value.' will not generate valid Javascript. Falling back to JSON output';
- }
- }
-};
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::View;
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c, $view ) = @_;
-
- # Views don't care / are not going to render an entity for 3XX
- # responses.
- return 1 if $c->response->status =~ /^(?:204|3\d\d)$/;
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
-
- if ( !$c->view($view) ) {
- $c->log->error("Could not load $view, refusing to serialize");
- return;
- }
-
- if ($c->view($view)->process($c, $stash_key)) {
- return 1;
- } else {
- # This is stupid. Please improve it.
- my $error = join("\n", @{ $c->error }) || "Error in $view";
- $error .= "\n";
- $c->clear_errors;
- die $error;
- }
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::XML::Simple;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- eval {
- require XML::Simple
- };
- if ($@) {
- $c->log->debug("Could not load XML::Serializer, refusing to serialize: $@")
- if $c->debug;
- return;
- }
- my $xs = XML::Simple->new(ForceArray => 0,);
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
- my $output = $xs->XMLout({ data => $c->stash->{$stash_key} });
- $c->response->output( $output );
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::YAML;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-use YAML::Syck;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
- my $output = $self->serialize($c->stash->{$stash_key});
- $c->response->output( $output );
- return 1;
-}
-
-sub serialize {
- my $self = shift;
- my $data = shift;
- Dump($data);
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::Serialize::YAML::HTML;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-use YAML::Syck;
-use URI::Find;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
-
- my $stash_key = (
- $controller->{'serialize'} ?
- $controller->{'serialize'}->{'stash_key'} :
- $controller->{'stash_key'}
- ) || 'rest';
- my $app = $c->config->{'name'} || '';
- my $output = "<html>";
- $output .= "<title>" . $app . "</title>";
- $output .= "<body><pre>";
- my $text = HTML::Entities::encode(Dump($c->stash->{$stash_key}));
- # Straight from URI::Find
- my $finder = URI::Find->new(
- sub {
- my($uri, $orig_uri) = @_;
- my $newuri;
- if ($uri =~ /\?/) {
- $newuri = $uri . "&content-type=text/html";
- } else {
- $newuri = $uri . "?content-type=text/html";
- }
- return qq|<a href="$newuri">$orig_uri</a>|;
- });
- $finder->find(\$text);
- $output .= $text;
- $output .= "</pre>";
- $output .= "</body>";
- $output .= "</html>";
- $c->response->output( $output );
- return 1;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Action::SerializeBase;
-
-use Moose;
-use namespace::autoclean;
-
-extends 'Catalyst::Action';
-use Module::Pluggable::Object;
-use Catalyst::Request::REST;
-use Catalyst::Utils ();
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-after BUILDARGS => sub {
- my $class = shift;
- my $config = shift;
- Catalyst::Request::REST->_insert_self_into( $config->{class} );
-};
-
-has [qw(_serialize_plugins _loaded_plugins)] => ( is => 'rw' );
-
-sub _load_content_plugins {
- my $self = shift;
- my ( $search_path, $controller, $c ) = @_;
-
- unless ( defined( $self->_loaded_plugins ) ) {
- $self->_loaded_plugins( {} );
- }
-
- # Load the Serialize Classes
- unless ( defined( $self->_serialize_plugins ) ) {
- my @plugins;
- my $mpo =
- Module::Pluggable::Object->new( 'search_path' => [$search_path], );
- @plugins = $mpo->plugins;
- $self->_serialize_plugins( \@plugins );
- }
-
- # Finally, we load the class. If you have a default serializer,
- # and we still don't have a content-type that exists in the map,
- # we'll use it.
- my $sclass = $search_path . "::";
- my $sarg;
- my $map;
-
- my $config;
-
- if ( exists $controller->{'serialize'} ) {
- $c->log->info("Catalyst::Action::REST - deprecated use of 'serialize' for configuration.");
- $c->log->info("Please see 'CONFIGURATION' in Catalyst::Controller::REST.");
- $config = $controller->{'serialize'};
- # if they're using the deprecated config, they may be expecting a
- # default mapping too.
- $config->{map} ||= $controller->{map};
- } else {
- $config = $controller;
- }
- $map = $config->{'map'};
-
- # pick preferred content type
- my @accepted_types; # priority order, best first
- # give top priority to content type specified by stash, if any
- my $content_type_stash_key = $config->{content_type_stash_key};
- if ($content_type_stash_key
- and my $stashed = $c->stash->{$content_type_stash_key}
- ) {
- # convert to array if not already a ref
- $stashed = [ $stashed ] if not ref $stashed;
- push @accepted_types, @$stashed;
- }
- # then content types requested by caller
- push @accepted_types, @{ $c->request->accepted_content_types };
- # then the default
- push @accepted_types, $config->{'default'} if $config->{'default'};
- # pick the best match that we have a serializer mapping for
- my ($content_type) = grep { $map->{$_} } @accepted_types;
-
- return $self->unsupported_media_type($c, $content_type)
- if not $content_type;
-
- # carp about old text/x-json
- if ($content_type eq 'text/x-json') {
- $c->log->info('Using deprecated text/x-json content-type.');
- $c->log->info('Use application/json instead!');
- }
-
- if ( exists( $map->{$content_type} ) ) {
- my $mc;
- if ( ref( $map->{$content_type} ) eq "ARRAY" ) {
- $mc = $map->{$content_type}->[0];
- $sarg = $map->{$content_type}->[1];
- } else {
- $mc = $map->{$content_type};
- }
- # TODO: Handle custom serializers more elegantly.. this is a start,
- # but how do we determine which is Serialize and Deserialize?
- #if ($mc =~ /^+/) {
- # $sclass = $mc;
- # $sclass =~ s/^+//g;
- #} else {
- $sclass .= $mc;
- #}
- if ( !grep( /^$sclass$/, @{ $self->_serialize_plugins } ) ) {
- return $self->unsupported_media_type($c, $content_type);
- }
- } else {
- return $self->unsupported_media_type($c, $content_type);
- }
- unless ( exists( $self->_loaded_plugins->{$sclass} ) ) {
- my $load_class = $sclass;
- $load_class =~ s/::/\//g;
- $load_class =~ s/$/.pm/g;
- eval { require $load_class; };
- if ($@) {
- $c->log->error(
- "Error loading $sclass for " . $content_type . ": $!" );
- return $self->unsupported_media_type($c, $content_type);
- } else {
- $self->_loaded_plugins->{$sclass} = 1;
- }
- }
-
- if ($search_path eq "Catalyst::Action::Serialize") {
- if ($content_type) {
- $c->response->header( 'Vary' => 'Content-Type' );
- } elsif ($c->request->accept_only) {
- $c->response->header( 'Vary' => 'Accept' );
- }
- $c->response->content_type($content_type);
- }
-
- return $sclass, $sarg, $content_type;
-}
-
-sub unsupported_media_type {
- my ( $self, $c, $content_type ) = @_;
- $c->res->content_type('text/plain');
- $c->res->status(415);
- if (defined($content_type) && $content_type ne "") {
- $c->res->body(
- "Content-Type " . $content_type . " is not supported.\r\n" );
- } else {
- $c->res->body(
- "Cannot find a Content-Type supported by your client.\r\n" );
- }
- return undef;
-}
-
-sub serialize_bad_request {
- my ( $self, $c, $content_type, $error ) = @_;
- $c->res->content_type('text/plain');
- $c->res->status(400);
- $c->res->body(
- "Content-Type " . $content_type . " had a problem with your request.\r\n***ERROR***\r\n$error" );
- return undef;
-}
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-=head1 NAME
-
-Catalyst::Action::SerializeBase - Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize.
-
-=head1 DESCRIPTION
-
-This module implements the plugin loading and content-type negotiating
-code for L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>.
-
-=head1 SEE ALSO
-
-L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>,
-L<Catalyst::Controller::REST>,
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Controller::REST;
-use Moose;
-use namespace::autoclean;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-=head1 NAME
-
-Catalyst::Controller::REST - A RESTful controller
-
-=head1 SYNOPSIS
-
- package Foo::Controller::Bar;
- use Moose;
- use namespace::autoclean;
-
- BEGIN { extends 'Catalyst::Controller::REST' }
-
- sub thing : Local : ActionClass('REST') { }
-
- # Answer GET requests to "thing"
- sub thing_GET {
- my ( $self, $c ) = @_;
-
- # Return a 200 OK, with the data in entity
- # serialized in the body
- $self->status_ok(
- $c,
- entity => {
- some => 'data',
- foo => 'is real bar-y',
- },
- );
- }
-
- # Answer PUT requests to "thing"
- sub thing_PUT {
- my ( $self, $c ) = @_;
-
- $radiohead = $c->req->data->{radiohead};
-
- $self->status_created(
- $c,
- location => $c->req->uri,
- entity => {
- radiohead => $radiohead,
- }
- );
- }
-
-=head1 DESCRIPTION
-
-Catalyst::Controller::REST implements a mechanism for building
-RESTful services in Catalyst. It does this by extending the
-normal Catalyst dispatch mechanism to allow for different
-subroutines to be called based on the HTTP Method requested,
-while also transparently handling all the serialization/deserialization for
-you.
-
-This is probably best served by an example. In the above
-controller, we have declared a Local Catalyst action on
-"sub thing", and have used the ActionClass('REST').
-
-Below, we have declared "thing_GET" and "thing_PUT". Any
-GET requests to thing will be dispatched to "thing_GET",
-while any PUT requests will be dispatched to "thing_PUT".
-
-Any unimplemented HTTP methods will be met with a "405 Method Not Allowed"
-response, automatically containing the proper list of available methods. You
-can override this behavior through implementing a custom
-C<thing_not_implemented> method.
-
-If you do not provide an OPTIONS handler, we will respond to any OPTIONS
-requests with a "200 OK", populating the Allowed header automatically.
-
-Any data included in C<< $c->stash->{'rest'} >> will be serialized for you.
-The serialization format will be selected based on the content-type
-of the incoming request. It is probably easier to use the L<STATUS HELPERS>,
-which are described below.
-
-"The HTTP POST, PUT, and OPTIONS methods will all automatically
-L<deserialize|Catalyst::Action::Deserialize> the contents of
-C<< $c->request->body >> into the C<< $c->request->data >> hashref", based on
-the request's C<Content-type> header. A list of understood serialization
-formats is L<below|/AVAILABLE SERIALIZERS>.
-
-If we do not have (or cannot run) a serializer for a given content-type, a 415
-"Unsupported Media Type" error is generated.
-
-To make your Controller RESTful, simply have it
-
- BEGIN { extends 'Catalyst::Controller::REST' }
-
-=head1 CONFIGURATION
-
-See L<Catalyst::Action::Serialize/CONFIGURATION>. Note that the C<serialize>
-key has been deprecated.
-
-=head1 SERIALIZATION
-
-Catalyst::Controller::REST will automatically serialize your
-responses, and deserialize any POST, PUT or OPTIONS requests. It evaluates
-which serializer to use by mapping a content-type to a Serialization module.
-We select the content-type based on:
-
-=over
-
-=item B<The Content-Type Header>
-
-If the incoming HTTP Request had a Content-Type header set, we will use it.
-
-=item B<The content-type Query Parameter>
-
-If this is a GET request, you can supply a content-type query parameter.
-
-=item B<Evaluating the Accept Header>
-
-Finally, if the client provided an Accept header, we will evaluate
-it and use the best-ranked choice.
-
-=back
-
-=head1 AVAILABLE SERIALIZERS
-
-A given serialization mechanism is only available if you have the underlying
-modules installed. For example, you can't use XML::Simple if it's not already
-installed.
-
-In addition, each serializer has its quirks in terms of what sorts of data
-structures it will properly handle. L<Catalyst::Controller::REST> makes
-no attempt to save you from yourself in this regard. :)
-
-=over 2
-
-=item * C<text/x-yaml> => C<YAML::Syck>
-
-Returns YAML generated by L<YAML::Syck>.
-
-=item * C<text/html> => C<YAML::HTML>
-
-This uses L<YAML::Syck> and L<URI::Find> to generate YAML with all URLs turned
-to hyperlinks. Only usable for Serialization.
-
-=item * C<application/json> => C<JSON>
-
-Uses L<JSON> to generate JSON output. It is strongly advised to also have
-L<JSON::XS> installed. The C<text/x-json> content type is supported but is
-deprecated and you will receive warnings in your log.
-
-You can also add a hash in your controller config to pass options to the json object.
-For instance, to relax permissions when deserializing input, add:
- __PACKAGE__->config(
- json_options => { relaxed => 1 }
- )
-
-=item * C<text/javascript> => C<JSONP>
-
-If a callback=? parameter is passed, this returns javascript in the form of: $callback($serializedJSON);
-
-Note - this is disabled by default as it can be a security risk if you are unaware.
-
-The usual MIME types for this serialization format are: 'text/javascript', 'application/x-javascript',
-'application/javascript'.
-
-=item * C<text/x-data-dumper> => C<Data::Serializer>
-
-Uses the L<Data::Serializer> module to generate L<Data::Dumper> output.
-
-=item * C<text/x-data-denter> => C<Data::Serializer>
-
-Uses the L<Data::Serializer> module to generate L<Data::Denter> output.
-
-=item * C<text/x-data-taxi> => C<Data::Serializer>
-
-Uses the L<Data::Serializer> module to generate L<Data::Taxi> output.
-
-=item * C<text/x-config-general> => C<Data::Serializer>
-
-Uses the L<Data::Serializer> module to generate L<Config::General> output.
-
-=item * C<text/x-php-serialization> => C<Data::Serializer>
-
-Uses the L<Data::Serializer> module to generate L<PHP::Serialization> output.
-
-=item * C<text/xml> => C<XML::Simple>
-
-Uses L<XML::Simple> to generate XML output. This is probably not suitable
-for any real heavy XML work. Due to L<XML::Simple>s requirement that the data
-you serialize be a HASHREF, we transform outgoing data to be in the form of:
-
- { data => $yourdata }
-
-=item * L<View>
-
-Uses a regular Catalyst view. For example, if you wanted to have your
-C<text/html> and C<text/xml> views rendered by TT, set:
-
- __PACKAGE__->config(
- map => {
- 'text/html' => [ 'View', 'TT' ],
- 'text/xml' => [ 'View', 'XML' ],
- }
- );
-
-Your views should have a C<process> method like this:
-
- sub process {
- my ( $self, $c, $stash_key ) = @_;
-
- my $output;
- eval {
- $output = $self->serialize( $c->stash->{$stash_key} );
- };
- return $@ if $@;
-
- $c->response->body( $output );
- return 1; # important
- }
-
- sub serialize {
- my ( $self, $data ) = @_;
-
- my $serialized = ... process $data here ...
-
- return $serialized;
- }
-
-=item * Callback
-
-For infinite flexibility, you can provide a callback for the
-deserialization/serialization steps.
-
- __PACKAGE__->config(
- map => {
- 'text/xml' => [ 'Callback', { deserialize => \&parse_xml, serialize => \&render_xml } ],
- }
- );
-
-The C<deserialize> callback is passed a string that is the body of the
-request and is expected to return a scalar value that results from
-the deserialization. The C<serialize> callback is passed the data
-structure that needs to be serialized and must return a string suitable
-for returning in the HTTP response. In addition to receiving the scalar
-to act on, both callbacks are passed the controller object and the context
-(i.e. C<$c>) as the second and third arguments.
-
-=back
-
-By default, L<Catalyst::Controller::REST> will return a
-C<415 Unsupported Media Type> response if an attempt to use an unsupported
-content-type is made. You can ensure that something is always returned by
-setting the C<default> config option:
-
- __PACKAGE__->config(default => 'text/x-yaml');
-
-would make it always fall back to the serializer plugin defined for
-C<text/x-yaml>.
-
-=head1 CUSTOM SERIALIZERS
-
-Implementing new Serialization formats is easy! Contributions
-are most welcome! If you would like to implement a custom serializer,
-you should create two new modules in the L<Catalyst::Action::Serialize>
-and L<Catalyst::Action::Deserialize> namespace. Then assign your new
-class to the content-type's you want, and you're done.
-
-See L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>
-for more information.
-
-=head1 STATUS HELPERS
-
-Since so much of REST is in using HTTP, we provide these Status Helpers.
-Using them will ensure that you are responding with the proper codes,
-headers, and entities.
-
-These helpers try and conform to the HTTP 1.1 Specification. You can
-refer to it at: L<http://www.w3.org/Protocols/rfc2616/rfc2616.txt>.
-These routines are all implemented as regular subroutines, and as
-such require you pass the current context ($c) as the first argument.
-
-=over
-
-=cut
-
-BEGIN { extends 'Catalyst::Controller' }
-use Params::Validate qw(SCALAR OBJECT);
-
-__PACKAGE__->mk_accessors(qw(serialize));
-
-__PACKAGE__->config(
- 'stash_key' => 'rest',
- 'map' => {
- 'text/html' => 'YAML::HTML',
- 'text/xml' => 'XML::Simple',
- 'text/x-yaml' => 'YAML',
- 'application/json' => 'JSON',
- 'text/x-json' => 'JSON',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- 'text/x-data-denter' => [ 'Data::Serializer', 'Data::Denter' ],
- 'text/x-data-taxi' => [ 'Data::Serializer', 'Data::Taxi' ],
- 'text/x-config-general' => [ 'Data::Serializer', 'Config::General' ],
- 'text/x-php-serialization' => [ 'Data::Serializer', 'PHP::Serialization' ],
- },
-);
-
-sub begin : ActionClass('Deserialize') { }
-
-sub end : ActionClass('Serialize') { }
-
-=item status_ok
-
-Returns a "200 OK" response. Takes an "entity" to serialize.
-
-Example:
-
- $self->status_ok(
- $c,
- entity => {
- radiohead => "Is a good band!",
- }
- );
-
-=cut
-
-sub status_ok {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate( @_, { entity => 1, }, );
-
- $c->response->status(200);
- $self->_set_entity( $c, $p{'entity'} );
- return 1;
-}
-
-=item status_created
-
-Returns a "201 CREATED" response. Takes an "entity" to serialize,
-and a "location" where the created object can be found.
-
-Example:
-
- $self->status_created(
- $c,
- location => $c->req->uri,
- entity => {
- radiohead => "Is a good band!",
- }
- );
-
-In the above example, we use the requested URI as our location.
-This is probably what you want for most PUT requests.
-
-=cut
-
-sub status_created {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate(
- @_,
- {
- location => { type => SCALAR | OBJECT },
- entity => { optional => 1 },
- },
- );
-
- $c->response->status(201);
- $c->response->header( 'Location' => $p{location} );
- $self->_set_entity( $c, $p{'entity'} );
- return 1;
-}
-
-=item status_accepted
-
-Returns a "202 ACCEPTED" response. Takes an "entity" to serialize.
-Also takes optional "location" for queue type scenarios.
-
-Example:
-
- $self->status_accepted(
- $c,
- location => $c->req->uri,
- entity => {
- status => "queued",
- }
- );
-
-=cut
-
-sub status_accepted {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate(
- @_,
- {
- location => { type => SCALAR | OBJECT, optional => 1 },
- entity => 1,
- },
- );
-
- $c->response->status(202);
- $c->response->header( 'Location' => $p{location} ) if exists $p{location};
- $self->_set_entity( $c, $p{'entity'} );
- return 1;
-}
-
-=item status_no_content
-
-Returns a "204 NO CONTENT" response.
-
-=cut
-
-sub status_no_content {
- my $self = shift;
- my $c = shift;
- $c->response->status(204);
- $self->_set_entity( $c, undef );
- return 1;
-}
-
-=item status_multiple_choices
-
-Returns a "300 MULTIPLE CHOICES" response. Takes an "entity" to serialize, which should
-provide list of possible locations. Also takes optional "location" for preferred choice.
-
-=cut
-
-sub status_multiple_choices {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate(
- @_,
- {
- entity => 1,
- location => { type => SCALAR | OBJECT, optional => 1 },
- },
- );
-
- $c->response->status(300);
- $c->response->header( 'Location' => $p{location} ) if exists $p{'location'};
- $self->_set_entity( $c, $p{'entity'} );
- return 1;
-}
-
-=item status_found
-
-Returns a "302 FOUND" response. Takes an "entity" to serialize.
-Also takes optional "location".
-
-=cut
-
-sub status_found {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate(
- @_,
- {
- entity => 1,
- location => { type => SCALAR | OBJECT, optional => 1 },
- },
- );
-
- $c->response->status(302);
- $c->response->header( 'Location' => $p{location} ) if exists $p{'location'};
- $self->_set_entity( $c, $p{'entity'} );
- return 1;
-}
-
-=item status_bad_request
-
-Returns a "400 BAD REQUEST" response. Takes a "message" argument
-as a scalar, which will become the value of "error" in the serialized
-response.
-
-Example:
-
- $self->status_bad_request(
- $c,
- message => "Cannot do what you have asked!",
- );
-
-=cut
-
-sub status_bad_request {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );
-
- $c->response->status(400);
- $c->log->debug( "Status Bad Request: " . $p{'message'} ) if $c->debug;
- $self->_set_entity( $c, { error => $p{'message'} } );
- return 1;
-}
-
-=item status_forbidden
-
-Returns a "403 FORBIDDEN" response. Takes a "message" argument
-as a scalar, which will become the value of "error" in the serialized
-response.
-
-Example:
-
- $self->status_forbidden(
- $c,
- message => "access denied",
- );
-
-=cut
-
-sub status_forbidden {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );
-
- $c->response->status(403);
- $c->log->debug( "Status Forbidden: " . $p{'message'} ) if $c->debug;
- $self->_set_entity( $c, { error => $p{'message'} } );
- return 1;
-}
-
-=item status_not_found
-
-Returns a "404 NOT FOUND" response. Takes a "message" argument
-as a scalar, which will become the value of "error" in the serialized
-response.
-
-Example:
-
- $self->status_not_found(
- $c,
- message => "Cannot find what you were looking for!",
- );
-
-=cut
-
-sub status_not_found {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );
-
- $c->response->status(404);
- $c->log->debug( "Status Not Found: " . $p{'message'} ) if $c->debug;
- $self->_set_entity( $c, { error => $p{'message'} } );
- return 1;
-}
-
-=item gone
-
-Returns a "41O GONE" response. Takes a "message" argument as a scalar,
-which will become the value of "error" in the serialized response.
-
-Example:
-
- $self->status_gone(
- $c,
- message => "The document have been deleted by foo",
- );
-
-=cut
-
-sub status_gone {
- my $self = shift;
- my $c = shift;
- my %p = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );
-
- $c->response->status(410);
- $c->log->debug( "Status Gone " . $p{'message'} ) if $c->debug;
- $self->_set_entity( $c, { error => $p{'message'} } );
- return 1;
-}
-
-sub _set_entity {
- my $self = shift;
- my $c = shift;
- my $entity = shift;
- if ( defined($entity) ) {
- $c->stash->{ $self->{'stash_key'} } = $entity;
- }
- return 1;
-}
-
-=back
-
-=head1 MANUAL RESPONSES
-
-If you want to construct your responses yourself, all you need to
-do is put the object you want serialized in $c->stash->{'rest'}.
-
-=head1 IMPLEMENTATION DETAILS
-
-This Controller ties together L<Catalyst::Action::REST>,
-L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>. It should be suitable for most applications. You should be aware that it:
-
-=over 4
-
-=item Configures the Serialization Actions
-
-This class provides a default configuration for Serialization. It is currently:
-
- __PACKAGE__->config(
- 'stash_key' => 'rest',
- 'map' => {
- 'text/html' => 'YAML::HTML',
- 'text/xml' => 'XML::Simple',
- 'text/x-yaml' => 'YAML',
- 'application/json' => 'JSON',
- 'text/x-json' => 'JSON',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- 'text/x-data-denter' => [ 'Data::Serializer', 'Data::Denter' ],
- 'text/x-data-taxi' => [ 'Data::Serializer', 'Data::Taxi' ],
- 'application/x-storable' => [ 'Data::Serializer', 'Storable' ],
- 'application/x-freezethaw' => [ 'Data::Serializer', 'FreezeThaw' ],
- 'text/x-config-general' => [ 'Data::Serializer', 'Config::General' ],
- 'text/x-php-serialization' => [ 'Data::Serializer', 'PHP::Serialization' ],
- },
- );
-
-You can read the full set of options for this configuration block in
-L<Catalyst::Action::Serialize>.
-
-=item Sets a C<begin> and C<end> method for you
-
-The C<begin> method uses L<Catalyst::Action::Deserialize>. The C<end>
-method uses L<Catalyst::Action::Serialize>. If you want to override
-either behavior, simply implement your own C<begin> and C<end> actions
-and forward to another action with the Serialize and/or Deserialize
-action classes:
-
- package Foo::Controller::Monkey;
- use Moose;
- use namespace::autoclean;
-
- BEGIN { extends 'Catalyst::Controller::REST' }
-
- sub begin : Private {
- my ($self, $c) = @_;
- ... do things before Deserializing ...
- $c->forward('deserialize');
- ... do things after Deserializing ...
- }
-
- sub deserialize : ActionClass('Deserialize') {}
-
- sub end :Private {
- my ($self, $c) = @_;
- ... do things before Serializing ...
- $c->forward('serialize');
- ... do things after Serializing ...
- }
-
- sub serialize : ActionClass('Serialize') {}
-
-If you need to deserialize multipart requests (i.e. REST data in
-one part and file uploads in others) you can do so by using the
-L<Catalyst::Action::DeserializeMultiPart> action class.
-
-=back
-
-=head1 A MILD WARNING
-
-I have code in production using L<Catalyst::Controller::REST>. That said,
-it is still under development, and it's possible that things may change
-between releases. I promise to not break things unnecessarily. :)
-
-=head1 SEE ALSO
-
-L<Catalyst::Action::REST>, L<Catalyst::Action::Serialize>,
-L<Catalyst::Action::Deserialize>
-
-For help with REST in general:
-
-The HTTP 1.1 Spec is required reading. http://www.w3.org/Protocols/rfc2616/rfc2616.txt
-
-Wikipedia! http://en.wikipedia.org/wiki/Representational_State_Transfer
-
-The REST Wiki: http://rest.blueoxen.net/cgi-bin/wiki.pl?FrontPage
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package Catalyst::Request::REST;
-use Moose;
-
-use Catalyst::Utils;
-use namespace::autoclean;
-
-extends 'Catalyst::Request';
-with 'Catalyst::TraitFor::Request::REST';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-# Please don't take this as a recommended way to do things.
-# The code below is grotty, badly factored and mostly here for back
-# compat..
-sub _insert_self_into {
- my ($class, $app_class ) = @_;
- # the fallback to $app_class is for the (rare and deprecated) case when
- # people are defining actions in MyApp.pm instead of in a controller.
- my $app = (blessed($app_class) && $app_class->can('_application'))
- ? $app_class->_application : Catalyst::Utils::class2appclass( $app_class ) || $app_class;
-
- my $req_class = $app->request_class;
- return if $req_class->isa($class);
- my $req_class_meta = Moose->init_meta( for_class => $req_class );
- my $role = $class->_related_role;
- return if $req_class_meta->does_role($role);
- if ($req_class eq 'Catalyst::Request') {
- $app->request_class($class);
- }
- else {
- my $meta = Moose::Meta::Class->create_anon_class(
- superclasses => [$req_class],
- roles => [$role],
- cache => 1
- );
- $meta->_add_meta_method('meta');
- $app->request_class($meta->name);
- }
-}
-
-sub _related_role { 'Catalyst::TraitFor::Request::REST' }
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Catalyst::Request::REST - A REST-y subclass of Catalyst::Request
-
-=head1 SYNOPSIS
-
- if ( $c->request->accepts('application/json') ) {
- ...
- }
-
- my $types = $c->request->accepted_content_types();
-
-=head1 DESCRIPTION
-
-This is a subclass of C<Catalyst::Request> that applies the
-L<Catalyst::TraitFor::Request::REST> role to your request class. That trait
-adds a few methods to the request object to facilitate writing REST-y code.
-
-This class is only here for backwards compatibility with applications already
-subclassing this class. New code should use
-L<Catalyst::TraitFor::Request::REST> directly.
-
-L<Catalyst::Action::REST> and L<Catalyst::Controller::REST> will arrange
-for the request trait to be applied if needed.
-
-=head1 SEE ALSO
-
-L<Catalyst::TraitFor::Request::REST>.
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Request::REST::ForBrowsers;
-use Moose;
-
-use namespace::autoclean;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-extends 'Catalyst::Request::REST';
-with 'Catalyst::TraitFor::Request::REST::ForBrowsers';
-
-sub _related_role { 'Catalyst::TraitFor::Request::REST::ForBrowsers' }
-
-__PACKAGE__->meta->make_immutable;
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Catalyst::Request::REST::ForBrowsers - A Catalyst::Request::REST subclass for dealing with browsers
-
-=head1 SYNOPSIS
-
- package MyApp;
-
- use Catalyst::Request::REST::ForBrowsers;
-
- MyApp->request_class( 'Catalyst::Request::REST::ForBrowsers' );
-
-=head1 DESCRIPTION
-
-This class has been deprecated in favor of
-L<Catalyst::TraitFor::Request::REST::ForBrowsers>. Please see that class for
-details on methods and attributes.
-
-=head1 AUTHOR
-
-Dave Rolsky, C<< <autarch@urth.org> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-catalyst-request-rest-forbrowsers@rt.cpan.org>, or through the
-web interface at L<http://rt.cpan.org>. I will be notified, and then
-you'll automatically be notified of progress on your bug as I make
-changes.
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008-2009 Dave Rolsky, All Rights Reserved.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::TraitFor::Request::REST;
-use Moose::Role;
-use HTTP::Headers::Util qw(split_header_words);
-use namespace::autoclean;
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-has [qw/ data accept_only /] => ( is => 'rw' );
-
-has accepted_content_types => (
- is => 'ro',
- isa => 'ArrayRef',
- lazy => 1,
- builder => '_build_accepted_content_types',
- init_arg => undef,
-);
-
-has preferred_content_type => (
- is => 'ro',
- isa => 'Str',
- lazy => 1,
- builder => '_build_preferred_content_type',
- init_arg => undef,
-);
-
-sub _build_accepted_content_types {
- my $self = shift;
-
- my %types;
-
- # First, we use the content type in the HTTP Request. It wins all.
- $types{ $self->content_type } = 3
- if $self->content_type;
-
- if ($self->method eq "GET" && $self->param('content-type')) {
- $types{ $self->param('content-type') } = 2;
- }
-
- # Third, we parse the Accept header, and see if the client
- # takes a format we understand.
- #
- # This is taken from chansen's Apache2::UploadProgress.
- if ( $self->header('Accept') ) {
- $self->accept_only(1) unless keys %types;
-
- my $accept_header = $self->header('Accept');
- my $counter = 0;
-
- foreach my $pair ( split_header_words($accept_header) ) {
- my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
- next if $types{$type};
-
- # cope with invalid (missing required q parameter) header like:
- # application/json; charset="utf-8"
- # http://tools.ietf.org/html/rfc2616#section-14.1
- unless ( defined $pair->[2] && lc $pair->[2] eq 'q' ) {
- $qvalue = undef;
- }
-
- unless ( defined $qvalue ) {
- $qvalue = 1 - ( ++$counter / 1000 );
- }
-
- $types{$type} = sprintf( '%.3f', $qvalue );
- }
- }
-
- [ sort { $types{$b} <=> $types{$a} } keys %types ];
-}
-
-sub _build_preferred_content_type { $_[0]->accepted_content_types->[0] }
-
-sub accepts {
- my $self = shift;
- my $type = shift;
-
- return grep { $_ eq $type } @{ $self->accepted_content_types };
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Catalyst::TraitFor::Request::REST - A role to apply to Catalyst::Request giving it REST methods and attributes.
-
-=head1 SYNOPSIS
-
- if ( $c->request->accepts('application/json') ) {
- ...
- }
-
- my $types = $c->request->accepted_content_types();
-
-=head1 DESCRIPTION
-
-This is a L<Moose::Role> applied to L<Catalyst::Request> that adds a few
-methods to the request object to facilitate writing REST-y code.
-Currently, these methods are all related to the content types accepted by
-the client.
-
-=head1 METHODS
-
-=over
-
-=item data
-
-If the request went through the Deserializer action, this method will
-return the deserialized data structure.
-
-=item accepted_content_types
-
-Returns an array reference of content types accepted by the
-client.
-
-The list of types is created by looking at the following sources:
-
-=over 8
-
-=item * Content-type header
-
-If this exists, this will always be the first type in the list.
-
-=item * content-type parameter
-
-If the request is a GET request and there is a "content-type"
-parameter in the query string, this will come before any types in the
-Accept header.
-
-=item * Accept header
-
-This will be parsed and the types found will be ordered by the
-relative quality specified for each type.
-
-=back
-
-If a type appears in more than one of these places, it is ordered based on
-where it is first found.
-
-=item preferred_content_type
-
-This returns the first content type found. It is shorthand for:
-
- $request->accepted_content_types->[0]
-
-=item accepts($type)
-
-Given a content type, this returns true if the type is accepted.
-
-Note that this does not do any wildcard expansion of types.
-
-=back
-
-=head1 AUTHORS
-
-See L<Catalyst::Action::REST> for authors.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-
+++ /dev/null
-package Catalyst::TraitFor::Request::REST::ForBrowsers;
-use Moose::Role;
-use namespace::autoclean;
-
-with 'Catalyst::TraitFor::Request::REST';
-
-our $VERSION = '1.07';
-$VERSION = eval $VERSION;
-
-has _determined_real_method => (
- is => 'rw',
- isa => 'Bool',
-);
-
-has looks_like_browser => (
- is => 'rw',
- isa => 'Bool',
- lazy => 1,
- builder => '_build_looks_like_browser',
- init_arg => undef,
-);
-
-# All this would be much less gross if Catalyst::Request used a builder to
-# determine the method. Then we could just wrap the builder.
-around method => sub {
- my $orig = shift;
- my $self = shift;
-
- return $self->$orig(@_)
- if @_ || $self->_determined_real_method;
-
- my $method = $self->$orig();
-
- my $tunneled;
- if ( defined $method && uc $method eq 'POST' ) {
- $tunneled = $self->param('x-tunneled-method')
- || $self->header('x-http-method-override');
- }
-
- $self->$orig( defined $tunneled ? uc $tunneled : $method );
-
- $self->_determined_real_method(1);
-
- return $self->$orig();
-};
-
-{
- my %HTMLTypes = map { $_ => 1 } qw(
- text/html
- application/xhtml+xml
- );
-
- sub _build_looks_like_browser {
- my $self = shift;
-
- my $with = $self->header('x-requested-with');
- return 0
- if $with && grep { $with eq $_ }
- qw( HTTP.Request XMLHttpRequest );
-
- if ( uc $self->method eq 'GET' ) {
- my $forced_type = $self->param('content-type');
- return 0
- if $forced_type && !$HTMLTypes{$forced_type};
- }
-
- # IE7 does not say it accepts any form of html, but _does_
- # accept */* (helpful ;)
- return 1
- if $self->accepts('*/*');
-
- return 1
- if grep { $self->accepts($_) } keys %HTMLTypes;
-
- return 0
- if @{ $self->accepted_content_types() };
-
- # If the client did not specify any content types at all,
- # assume they are a browser.
- return 1;
- }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Catalyst::TraitFor::Request::REST::ForBrowsers - A request trait for REST and browsers
-
-=head1 SYNOPSIS
-
- package MyApp;
- use Moose;
- use namespace::autoclean;
-
- use Catalyst;
- use CatalystX::RoleApplicator;
-
- extends 'Catalyst';
-
- __PACKAGE__->apply_request_class_roles(qw[
- Catalyst::TraitFor::Request::REST::ForBrowsers
- ]);
-
-=head1 DESCRIPTION
-
-Writing REST-y apps is a good thing, but if you're also trying to support web
-browsers, you're probably going to need some hackish workarounds. This module
-provides those workarounds for you.
-
-Specifically, it lets you do two things. First, it lets you "tunnel" PUT and
-DELETE requests across a POST, since most browsers do not support PUT or
-DELETE actions (as of early 2009, at least).
-
-Second, it provides a heuristic to check if the client is a web browser,
-regardless of what content types it claims to accept. The reason for this is
-that while a browser might claim to accept the "application/xml" content type,
-it's really not going to do anything useful with it, and you're best off
-giving it HTML.
-
-=head1 METHODS
-
-This class provides the following methods:
-
-=head2 $request->method
-
-This method works just like C<< Catalyst::Request->method() >> except it
-allows for tunneling of PUT and DELETE requests via a POST.
-
-Specifically, you can provide a form element named "x-tunneled-method" which
-can override the request method for a POST. This I<only> works for a POST, not
-a GET.
-
-You can also use a header named "x-http-method-override" instead (Google uses
-this header for its APIs).
-
-=head2 $request->looks_like_browser
-
-This attribute provides a heuristic to determine whether or not the request
-I<appears> to come from a browser. You can use this however you want. I
-usually use it to determine whether or not to give the client a full HTML page
-or some sort of serialized data.
-
-This is a heuristic, and like any heuristic, it is probably wrong
-sometimes. Here is how it works:
-
-=over 4
-
-=item *
-
-If the request includes a header "X-Request-With" set to either "HTTP.Request"
-or "XMLHttpRequest", this returns false. The assumption is that if you're
-doing XHR, you don't want the request treated as if it comes from a browser.
-
-=item *
-
-If the client makes a GET request with a query string parameter
-"content-type", and that type is I<not> an HTML type, it is I<not> a browser.
-
-=item *
-
-If the client provides an Accept header which includes "*/*" as an accepted
-content type, the client is a browser. Specifically, it is IE7, which submits
-an Accept header of "*/*". IE7's Accept header does not include any html types
-like "text/html".
-
-=item *
-
-If the client provides an Accept header and accepts either "text/html" or
-"application/xhtml+xml" it is a browser.
-
-=item *
-
-If it provides an Accept header of any sort that doesn't match one of the
-above criteria, it is I<not> a browser.
-
-=item *
-
-The default is that the client is a browser.
-
-=back
-
-This all works well for my apps, but read it carefully to make sure it meets
-your expectations before using it.
-
-=head1 AUTHOR
-
-Dave Rolsky, C<< <autarch@urth.org> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-catalyst-action-rest@rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org>. We will be notified, and then you'll automatically be
-notified of progress on your bug as I make changes.
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008-2010 Dave Rolsky, All Rights Reserved.
-
-This program is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
+++ /dev/null
-package Catalyst::Action::Serializer::Broken;
-
-use Moose;
-use namespace::autoclean;
-
-use Bilbo::Baggins;
-
-1;
-
+++ /dev/null
-package Catalyst::Action::Serializer::Broken;
-
-use Moose;
-use namespace::autoclean;
-
-use Bilbo::Baggins;
-
-1;
-
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
-use Test::Rest;
-
-use_ok 'Catalyst::Test', 'Test::Serialize';
-
-my $t = Test::Rest->new('content_type' => 'text/my-csv');
-
-my $has_serializer = eval "require XML::Simple";
-
- my $monkey_template = {
- monkey => 'likes chicken!',
- };
- my $mres = request($t->get(url => '/monkey_get'));
- ok( $mres->is_success, 'GET the monkey succeeded' );
- my $output = { split( /,/, $mres->content ) };
- is_deeply($output, $monkey_template, "GET returned the right data");
-
- my $post_data = {
- 'sushi' => 'is good for monkey',
- };
- my $mres_post = request( $t->post( url => '/monkey_put', data => join( ',', %$post_data ) ) );
- ok( $mres_post->is_success, "POST to the monkey succeeded");
- is_deeply($mres_post->content, "is good for monkey", "POST data matches");
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use YAML::Syck;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-
-my $t = Test::Rest->new('content_type' => 'multipart/mixed; boundary=----------------------------0b922a55b662');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-my $url = '/deserializemultipart/test';
-
-my $req = $t->put( url => $url, data => qq(------------------------------0b922a55b662\r\nContent-Disposition: form-data; name="REST"; filename="-"\r\nContent-Type: text/x-yaml\r\n\r\n---\r\nkitty: LouLou\r\n------------------------------0b922a55b662\r\nContent-Disposition: form-data; name="other"; filename="foo.txt"\r\nContent-Type: application/octet-stream\r\n\r\nanother part\r\n------------------------------0b922a55b662--\r\n));
-my $res = request($req);
-
-ok( $res->is_success, 'PUT Deserialize request succeeded' );
-is( $res->content, "LouLou|12", "Request returned deserialized data");
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use YAML::Syck;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-
-# Should use Data::Dumper, via Data::Serializer
-my $t = Test::Rest->new('content_type' => 'text/x-yaml');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-my $url = '/deserialize/test';
-
-my $req = $t->put( url => $url, data => Dump({ kitty => "LouLou" }));
-my $res = request($req);
-ok( $res->is_success, 'PUT Deserialize request succeeded' );
-is( $res->content, "LouLou", "Request returned deserialized data");
-
-$req->method('GET');
-isnt( request($req)->content, 'LouLou', 'GET request with body does not work by default' );
-
-$req->url('/deserialize/test_action_args');
-is( request($req)->content, 'LouLou', 'GET request via action_args');
-
-my $nt = Test::Rest->new('content_type' => 'text/broken');
-my $bres = request($nt->put( url => $url, data => Dump({ kitty => "LouLou" })));
-is( $bres->code, 415, 'PUT on un-useable Deserialize class returns 415');
-
-my $ut = Test::Rest->new('content_type' => 'text/not-happening');
-my $ures = request($ut->put( url => $url, data => Dump({ kitty => "LouLou" })));
-is ($bres->code, 415, 'GET on unknown Content-Type returns 415');
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
-use Test::Rest;
-
-my $t = Test::Rest->new( 'content_type' => 'text/plain' );
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-my $url = '/actionsforbrowsers/for_browsers';
-
-foreach my $method (qw(GET POST)) {
- my $run_method = lc($method);
- my $result = "something $method";
- my $res;
- if ( $method eq 'GET' ) {
- $res = request( $t->$run_method( url => $url ) );
- } else {
- $res = request(
- $t->$run_method(
- url => $url,
- data => '',
- )
- );
- }
- ok( $res->is_success, "$method request succeeded" );
- is(
- $res->content,
- "$method",
- "$method request had proper response"
- );
-}
-
-my $res = request(
- $t->get(
- url => $url,
- headers => { Accept => 'text/html' },
- )
-);
-
-ok( $res->is_success, "GET request succeeded (client looks like browser)" );
-is(
- $res->content,
- "GET_html",
- "GET request had proper response (client looks like browser)"
-);
-
-done_testing;
-
+++ /dev/null
-use strict;
-use warnings;
-use Test::More 0.88;
-use FindBin;
-use Data::Dumper;
-use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
-use Test::Rest;
-
-# Should use the default serializer, YAML
-my $t = Test::Rest->new( 'content_type' => 'text/plain' );
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-foreach my $endpoint (qw/ test other_test /) {
- foreach my $method (qw(GET DELETE POST PUT OPTIONS)) {
- my $run_method = lc($method);
- my $res;
- if ( grep /$method/, qw(GET DELETE OPTIONS) ) {
- $res = request( $t->$run_method( url => '/actions/' . $endpoint ) );
- }
- else {
- $res = request(
- $t->$run_method(
- url => '/actions/' . $endpoint,
- data => '',
- )
- );
- }
- ok( $res->is_success, "$method request succeeded" ) or warn Dumper($res);
- is(
- $res->content,
- "$method",
- "$method request had proper response"
- );
- is(
- $res->header('X-Was-In-TopLevel'),
- '1',
- "went through top level action for dispatching to $method"
- );
- is(
- $res->header('Using-Action'),
- 'STATION',
- "went through action for dispatching to $method"
- );
- }
-}
-
-my $head_res = request( $t->head(url => '/actions/test') );
-ok($head_res->is_success, 'HEAD request succeeded')
- or diag($head_res->code);
-ok(!$head_res->content, 'HEAD request had proper response');
-
-my $res = request(
- $t->put(
- url => '/actions/test',
- data => '',
- )
-);
-is(
- $res->header('Using-Action'),
- 'STATION',
- "went through action for dispatching to PUT"
-);
-is(
- $res->header('Using-Sub-Action'),
- 'MOO',
- "went through sub action for dispatching to PUT"
-);
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
-use Test::Rest;
-
-# Should use the default serializer, YAML
-my $t = Test::Rest->new( 'content_type' => 'text/plain' );
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-foreach my $method (qw(GET DELETE POST PUT OPTIONS)) {
- my $run_method = lc($method);
- my $result = "something $method";
- my $res;
- if ( grep /$method/, qw(GET DELETE OPTIONS) ) {
- $res = request( $t->$run_method( url => '/test' ) );
- } else {
- $res = request(
- $t->$run_method(
- url => '/test',
- data => '',
- )
- );
- }
- ok( $res->is_success, "$method request succeeded" );
- is(
- $res->content,
- "something $method",
- "$method request had proper response"
- );
-}
-
-my $head_res = request( $t->head(url => '/test') );
-ok($head_res->is_success, 'HEAD request succeeded')
- or diag($head_res->code);
-ok(!$head_res->content, 'HEAD request had proper response');
-
-$head_res = request( $t->head(url => '/actions/yet_other_test') );
-ok($head_res->code == 405, 'HEAD request succeeded')
- or diag($head_res->code);
-
-my $fail_res = request( $t->delete( url => '/notreally' ) );
-is( $fail_res->code, 405, "Request to bad method gets 405 Not Implemented" );
-is( $fail_res->header('allow'), "GET, HEAD", "405 allow header properly set." );
-
-my $options_res = request( $t->options( url => '/notreally' ) );
-is( $options_res->code, 200, "OPTIONS request handler succeeded" );
-is( $options_res->header('allow'),
- "GET, HEAD", "OPTIONS request allow header properly set." );
-
-my $opts_res = request( $t->options( url => '/rest/opts' ) );
-is( $opts_res->code, 200, "OPTIONS request handler succeeded" );
-is( $opts_res->header('allow'),
- "GET, HEAD", "OPTIONS request allow header properly set." );
-is($opts_res->content, q{}, 'should have no body');
-
-$opts_res = request(
- $t->options(
- url => '/rest/opts',
- headers => { Accept => 'application/json' },
- )
-);
-is( $opts_res->code, 200, "OPTIONS request handler succeeded" );
-is( $opts_res->header('allow'),
- "GET, HEAD", "OPTIONS request allow header properly set." );
-is($opts_res->content, q{}, 'should have no body');
-
-my $modified_res = request( $t->get( url => '/not_modified' ) );
-is( $modified_res->code, 304, "Not Modified request handler succeeded" );
-
-my $ni_res = request( $t->delete( url => '/not_implemented' ) );
-is( $ni_res->code, 200, "Custom not_implemented handler succeeded" );
-is(
- $ni_res->content,
- "Not Implemented Handler",
- "not_implemented handler had proper response"
-);
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use Data::Serializer;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-use Catalyst::Action::Serialize::YAML;
-
-# Should use Data::Dumper, via YAML
-my $t = Test::Rest->new('content_type' => 'text/x-yaml');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-# to avoid whatever serialization bugs YAML::Syck has,
-# e.g. http://rt.cpan.org/Public/Bug/Display.html?id=46983,
-# we won't hardcode the expected output
-my $output_YAML = Catalyst::Action::Serialize::YAML->serialize({lou => 'is my cat'});
-
-{
- my $req = $t->get(url => '/serialize/test');
- $req->remove_header('Content-Type');
- $req->header('Accept', 'text/x-yaml');
- my $res = request($req);
- SKIP: {
- skip "can't test text/x-yaml without YAML support",
- 3 if (
- not $res->is_success and
- $res->content =~ m#Content-Type text/x-yaml is not supported#
- );
- ok( $res->is_success, 'GET the serialized request succeeded' );
- is( $res->content, $output_YAML, "Request returned proper data");
- is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
-
- };
-}
-
-SKIP: {
- eval 'use JSON 2.12;';
- skip "can't test application/json without JSON support", 3 if $@;
- my $json = JSON->new;
- my $at = Test::Rest->new('content_type' => 'text/doesnt-exist');
- my $req = $at->get(url => '/serialize/test');
- $req->header('Accept', 'application/json');
- my $res = request($req);
- ok( $res->is_success, 'GET the serialized request succeeded' );
- my $ret = $json->decode($res->content);
- is( $ret->{lou}, 'is my cat', "Request returned proper data");
- is( $res->header('Content-type'), 'application/json', 'Accept header used if content-type mapping not found')
-};
-
-# Make sure we don't get a bogus content-type when using the default
-# serializer (https://rt.cpan.org/Ticket/Display.html?id=27949)
-{
- my $req = $t->get(url => '/serialize/test');
- $req->remove_header('Content-Type');
- $req->header('Accept', '*/*');
- my $res = request($req);
- ok( $res->is_success, 'GET the serialized request succeeded' );
- is( $res->content, $output_YAML, "Request returned proper data");
- is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
-}
-
-# Make sure that when using content_type_stash_key, an invalid value in the stash gets ignored
-{
- my $req = $t->get(url => '/serialize/test_second?serialize_content_type=nonesuch');
- $req->remove_header('Content-Type');
- $req->header('Accept', '*/*');
- my $res = request($req);
- ok( $res->is_success, 'GET the serialized request succeeded' );
- is( $res->content, $output_YAML, "Request returned proper data");
- is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
-}
-
-# Make sure that when using content_type_stash_key, a valid value in the stash gets priority.
-# This also tests that application-level config is properly passed to
-# individual controllers; see t/lib/Test/Catalyst/Action/REST.pm
-{
- my $req = $t->get(url =>
- '/serialize/test_second?serialize_content_type=text/x-data-dumper'
- );
- $req->remove_header('Content-Type');
- $req->header('Accept', '*/*');
- my $res = request($req);
- ok( $res->is_success, 'GET the serialized request succeeded' );
- is( $res->content, "{'lou' => 'is my cat'}", "Request returned proper data");
- is( $res->header('Content-type'), 'text/x-data-dumper', '... with expected content-type')
-}
-
-# Make sure that the default content type you specify really gets used.
-{
- my $req = $t->get(url => '/override/test');
- $req->remove_header('Content-Type');
- my $res = request($req);
- ok( $res->is_success, 'GET the serialized request succeeded' );
- is( $res->content, "--- \nlou: is my cat\n", "Request returned proper data");
-}
-
-done_testing;
-
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-
-# YAML
-my $t = Test::Rest->new('content_type' => 'text/x-yaml');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-my $req = $t->get(url => '/serialize/test?content-type=text/x-yaml');
-$req->remove_header('Content-Type');
-my $res = request($req);
-ok( $res->is_success, 'GET the serialized request succeeded' );
-my $data = <<EOH;
----
-lou: is my cat
-EOH
-is( $res->content, $data, "Request returned proper data");
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-
-use Test::More 0.88;
-use Data::Serializer;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-
-# Should use Data::Dumper, via YAML
-my $t = Test::Rest->new('content_type' => 'text/x-data-dumper');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-my $res = request($t->get(url => '/serialize/test'));
-ok( $res->is_success, 'GET the serialized request succeeded' );
-is( $res->content, "{'lou' => 'is my cat'}", "Request returned proper data");
-
-my $nt = Test::Rest->new('content_type' => 'text/broken');
-my $bres = request($nt->get(url => '/serialize/test'));
-is( $bres->code, 415, 'GET on un-useable Serialize class returns 415');
-
-my $ut = Test::Rest->new('content_type' => 'text/not-happening');
-my $ures = request($ut->get(url => '/serialize/test'));
-is ($bres->code, 415, 'GET on unknown Content-Type returns 415');
-
-# This check is to make sure we can still serialize after the first
-# request.
-my $res2 = request($t->get(url => '/serialize/test_second'));
-ok( $res2->is_success, '2nd request succeeded' );
-is( $res2->content, "{'lou' => 'is my cat'}", "2nd request returned proper data");
-
-Test::Catalyst::Action::REST->controller('Serialize')->{serialize} = {};
-$res2 = request($t->get(url => '/serialize/test_second'));
-ok( $res2->is_success, 'request succeeded (deprecated config)' );
-is( $res2->content, "{'lou' => 'is my cat'}", "request returned proper data");
-
-
-$res = request($t->get(url => '/serialize/empty_serialized'));
-is $res->content, q[{'foo' => 'bar'}], 'normal case ok';
-ok $res->header('Content-Length'), 'set content-length when we serialize';
-
-$res = request($t->get(url => '/serialize/empty_not_serialized_blank'));
-is $res->content, '', "body explicitly set to '' results in '' content";
-ok !$res->header('Content-Length'), "body explicitly set to '' - no automatic content-length";
-
-$res = request($t->get(url => '/serialize/explicit_view'));
-is $res->content, '', "view explicitly set to '' results in '' content";
-ok !$res->header('Content-Length'), "view explicitly set to '' - no automatic content-length";
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use YAML::Syck;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
-use Test::Rest;
-
-my $t = Test::Rest->new(content_type => 'text/x-yaml');
-
-use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
-
-my $data = { your => 'face' };
-is_deeply(
- Load(
- request($t->put(url => '/rest/test', data => Dump($data)))->content
- ),
- { test => 'worked', data => $data },
- 'round trip (deserialize/serialize)',
-);
-
-
-ok my $res = request( $t->get( url => '/rest/test_status_created' ) );
-is $res->code, 201, "... status created";
-is $res->header('Location'), '/rest', "...location of what was created";
-
-ok $res = request( $t->get( url => '/rest/test_status_accepted' ) );
-is $res->code, 202, "... status accepted";
-is $res->header('Location'), '/rest', "...location of what was accepted";
-
-ok $res = request( $t->get( url => '/rest/test_status_no_content' ) );
-is $res->code, 204, "... status no content";
-is $res->content, '', '... no content';
-
-ok $res = request( $t->get( url => '/rest/test_status_found' ) );
-is $res->code, 302, '... status found';
-is_deeply Load( $res->content ),
- { status => 'found' },
- "... status found message";
-is $res->header('Location'), '/rest', "...location of what was found";
-
-ok $res = request( $t->get( url => '/rest/test_status_bad_request' ) );
-is $res->code, 400, '... status bad request';
-is_deeply Load( $res->content ),
- { error => "Cannot do what you have asked!" },
- "... status bad request message";
-
-ok $res = request( $t->get( url => '/rest/test_status_forbidden' ) );
-is $res->code, 403, '... status forbidden';
-is_deeply Load( $res->content ),
- { error => "access denied" },
- "... status forbidden";
-
-ok $res = request( $t->get( url => '/rest/test_status_not_found' ) );
-is $res->code, 404, '... status not found';
-is_deeply Load( $res->content ),
- { error => "Cannot find what you were looking for!" },
- "... status bad request message";
-
-ok $res = request( $t->get( url => '/rest/test_status_gone' ) );
-is $res->code, 410, '... status gone';
-is_deeply Load( $res->content ),
- { error => "Document have been deleted by foo" },
- "... status gone message";
-
-ok $res = request( $t->get( url => '/rest/test_status_multiple_choices' ) );
-is $res->code, 300, "... multiple choices";
-is_deeply Load($res->content),
- { choices => [qw(/rest/choice1 /rest/choice2)] },
- "... 300 multiple choices has response body";
-is $res->header('Location'), '/rest/choice1', "...main location of what was found";
-
-done_testing;
-
+++ /dev/null
-use strict;
-use warnings;
-
-use Test::More;
-
-use Catalyst::Request;
-use Catalyst::Request::REST::ForBrowsers;
-use Catalyst::TraitFor::Request::REST::ForBrowsers;
-use Moose::Meta::Class;
-use HTTP::Headers;
-use Catalyst::Log;
-
-my $anon_class = Moose::Meta::Class->create_anon_class(
- superclasses => ['Catalyst::Request'],
- roles => ['Catalyst::TraitFor::Request::REST::ForBrowsers'],
- cache => 1,
-)->name;
-
-# We run the tests twice to make sure Catalyst::Request::REST::ForBrowsers is
-# 100% back-compatible.
-for my $class ( $anon_class, 'Catalyst::Request::REST::ForBrowsers' ) {
- {
- for my $method (qw( GET POST PUT DELETE )) {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->method($method);
- $req->{_context} = 'MockContext';
- $req->parameters( {} );
-
- is(
- $req->method(), $method,
- "$method - not tunneled"
- );
- }
- }
-
- {
- for my $method (qw( PUT DELETE )) {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->method('POST');
- $req->{_context} = 'MockContext';
- $req->parameters( { 'x-tunneled-method' => $method } );
-
- is(
- $req->method(), $method,
- "$method - tunneled with x-tunneled-method param"
- );
- }
- }
-
- {
- for my $method (qw( PUT DELETE )) {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->method('POST');
- $req->{_context} = 'MockContext';
- $req->header( 'x-http-method-override' => $method );
-
- is(
- $req->method(), $method,
- "$method - tunneled with x-http-method-override header"
- );
- }
- }
-
- {
- for my $method (qw( PUT DELETE )) {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->method('GET');
- $req->{_context} = 'MockContext';
- $req->parameters( { 'x-tunneled-method' => $method } );
-
- is(
- $req->method(), 'GET',
- 'x-tunneled-method is ignore with a GET'
- );
- }
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( {} );
- $req->headers( HTTP::Headers->new() );
-
- ok(
- $req->looks_like_browser(),
- 'default is a browser'
- );
- }
-
- {
- for my $with (qw( HTTP.Request XMLHttpRequest )) {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->headers(
- HTTP::Headers->new( 'X-Requested-With' => $with ) );
-
- ok(
- !$req->looks_like_browser(),
- "not a browser - X-Request-With = $with"
- );
- }
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( { 'content-type' => 'text/json' } );
- $req->headers( HTTP::Headers->new() );
-
- ok(
- !$req->looks_like_browser(),
- 'forced non-HTML content-type is not a browser'
- );
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( { 'content-type' => 'text/html' } );
- $req->headers( HTTP::Headers->new() );
-
- ok(
- $req->looks_like_browser(),
- 'forced HTML content-type is not a browser'
- );
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( {} );
- $req->headers(
- HTTP::Headers->new( 'Accept' => 'text/xml; q=0.4, */*; q=0.2' ) );
-
- ok(
- $req->looks_like_browser(),
- 'if it accepts */* it is a browser'
- );
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( {} );
- $req->headers(
- HTTP::Headers->new(
- 'Accept' => 'text/html; q=0.4, text/xml; q=0.2'
- )
- );
-
- ok(
- $req->looks_like_browser(),
- 'if it accepts text/html it is a browser'
- );
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( {} );
- $req->headers(
- HTTP::Headers->new(
- 'Accept' => 'application/xhtml+xml; q=0.4, text/xml; q=0.2'
- )
- );
-
- ok(
- $req->looks_like_browser(),
- 'if it accepts application/xhtml+xml it is a browser'
- );
- }
-
- {
- my $req = $class->new(
- _log => Catalyst::Log->new,
- );
- $req->{_context} = 'MockContext';
- $req->method('GET');
- $req->parameters( {} );
- $req->headers(
- HTTP::Headers->new(
- 'Accept' => 'text/json; q=0.4, text/xml; q=0.2'
- )
- );
-
- ok(
- !$req->looks_like_browser(),
- 'provided an Accept header but does not accept html, is not a browser'
- );
- }
-}
-
-done_testing;
-
-package MockContext;
-
-sub prepare_body { }
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-use lib ( "$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib" );
-
-use Catalyst::Request::REST;
-use Catalyst::TraitFor::Request::REST;
-use Moose::Meta::Class;
-use HTTP::Headers;
-use Catalyst::Log;
-
-my $anon_class = Moose::Meta::Class->create_anon_class(
- superclasses => ['Catalyst::Request'],
- roles => ['Catalyst::TraitFor::Request::REST::ForBrowsers'],
- cache => 1,
-)->name;
-
-for my $class ( $anon_class, 'Catalyst::Request::REST' ) {
- {
- my $request = Catalyst::Request::REST->new(
- _log => Catalyst::Log->new
- );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('text/foobar');
-
- is_deeply( $request->accepted_content_types, [ 'text/foobar' ],
- 'content-type set in request headers is found' );
- is( $request->preferred_content_type, 'text/foobar',
- 'preferred content type is text/foobar' );
- ok( ! $request->accept_only, 'accept_only is false' );
- ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
- ok( ! $request->accepts('text/html'), 'does not accept text/html' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( { 'content-type' => 'text/fudge' } );
- $request->method('GET');
- $request->content_type('text/foobar');
-
- is_deeply( $request->accepted_content_types, [ 'text/foobar', 'text/fudge' ],
- 'content-type set in request headers and type in parameters is found' );
- is( $request->preferred_content_type, 'text/foobar',
- 'preferred content type is text/foobar' );
- ok( ! $request->accept_only, 'accept_only is false' );
- ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
- ok( $request->accepts('text/fudge'), 'accepts text/fudge' );
- ok( ! $request->accepts('text/html'), 'does not accept text/html' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( { 'content-type' => 'text/fudge' } );
- $request->method('POST');
- $request->content_type('text/foobar');
-
- ok( ! $request->accepts('text/fudge'), 'content type in parameters is ignored for POST' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly' );
- is( $request->preferred_content_type, 'text/xml',
- 'preferred content type is text/xml' );
- ok( $request->accept_only, 'accept_only is true' );
- ok( $request->accepts('text/html'), 'accepts text/html' );
- ok( $request->accepts('image/png'), 'accepts image/png' );
- ok( ! $request->accepts('image/svg'), 'does not accept image/svg' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly, and content-type header has precedence over accept' );
- ok( ! $request->accept_only, 'accept_only is false' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly, and content-type header has precedence over accept' );
- ok( ! $request->accept_only, 'accept_only is false' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('text/x-json');
- $request->headers->header(
- 'Accept' => 'text/plain,text/x-json',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( text/x-json
- text/plain
- ) ],
- 'each type appears only once' );
- }
-
- {
- my $request = Catalyst::Request::REST->new( _log => Catalyst::Log->new );
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' => 'text/plain,application/json',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/plain
- ) ],
- 'each type appears only once' );
- }
-}
-
-{
- local %ENV=%ENV;
- $ENV{CATALYST_DEBUG} = 0;
- my $test = 'Test::Catalyst::Action::REST';
- use_ok $test;
- ok($test->request_class->does('Catalyst::TraitFor::Request::REST'),
- 'Request does Catalyst::TraitFor::Request::REST');
-
- my $meta = Moose::Meta::Class->create_anon_class(
- superclasses => ['Catalyst::Request'],
- );
- $meta->add_method('__random_method' => sub { 42 });
-
- $test->request_class($meta->name);
- # FIXME - setup_finished(0) is evil!
- eval { $test->setup_finished(0); $test->setup };
- ok !$@, 'Can setup again';
- isnt $test->request_class, $meta->name, 'Different request class';
- ok $test->request_class->can('__random_method'), 'Is right class';
- ok $test->request_class->can('data'), 'Also smells like REST subclass';
-
- {
- package My::Request;
- use base 'Catalyst::Request::REST';
- }
- $test->request_class('My::Request');
- eval { $test->setup_finished(0); $test->setup };
- is $@, '', 'no error from Request::REST subclass';
-}
-
-done_testing;
-
-package MockContext;
-
-sub prepare_body { }
+++ /dev/null
-use strict;
-use warnings;
-
-use FindBin qw/$Bin/;
-use lib "$Bin/lib";
-
-use Test::More;
-
-use Test::Catalyst::Action::REST;
-
-my $controller = Test::Catalyst::Action::REST->controller('Root');
-ok $controller;
-
-my $action = $controller->action_for('test');
-ok $action;
-
-isa_ok($action, 'Catalyst::Action::REST');
-ok(!$action->isa('Catalyst'));
-ok(!$action->isa('Catalyst::Controller'));
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
-use Test::Rest;
-use utf8;
-
-eval 'use JSON 2.12';
-plan skip_all => 'Install JSON 2.12 or later to run this test' if ($@);
-
-
-use_ok 'Catalyst::Test', 'Test::Serialize';
-
-my $json = JSON->new->utf8;
-# The text/x-json should throw a warning
-for ('text/x-json', 'application/json') {
- my $t = Test::Rest->new('content_type' => $_);
- my $monkey_template = {
- monkey => 'likes chicken!',
- };
- my $mres = request($t->get(url => '/monkey_get'));
- ok( $mres->is_success, 'GET the monkey succeeded' );
- is_deeply($json->decode($mres->content), $monkey_template, "GET returned the right data");
-
- my $post_data = {
- 'sushi' => 'is good for monkey',
- 'chicken' => ' 佐藤 純',
- };
- my $mres_post = request($t->post(url => '/monkey_put', data => $json->encode($post_data)));
- ok( $mres_post->is_success, "POST to the monkey succeeded");
- my $exp = "is good for monkey 佐藤 純";
- utf8::encode($exp);
- is_deeply($mres_post->content, $exp, "POST data matches");
-}
-
-{
- my $t = Test::Rest->new('content_type' => 'application/json');
- my $json_data = '{ "sushi":"is good for monkey", }';
- my $mres_post = request($t->post(url => '/monkey_put', data => $json_data));
- ok( ! $mres_post->is_success, "Got expected failed status due to invalid JSON" );
-
- my $relaxed_post = request( $t->post(url => "/monkey_json_put", data => $json_data));
- ok( $relaxed_post->is_success, "Got success due to setting relaxed JSON input" );
-}
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
-use Test::Rest;
-use utf8;
-
-eval 'use JSON 2.12';
-plan skip_all => 'Install JSON 2.12 or later to run this test' if ($@);
-
-
-use_ok 'Catalyst::Test', 'Test::Serialize', 'Catalyst::Action::Serialize::JSON';
-
-my $json = JSON->new->utf8;
-
-for ('text/javascript','application/x-javascript','application/javascript') {
- my $t = Test::Rest->new('content_type' => $_);
- my $monkey_template = { monkey => 'likes chicken!' };
-
- my $mres = request($t->get(url => '/monkey_get?callback=My_Animal.omnivore'));
- ok( $mres->is_success, 'GET the monkey succeeded' );
-
- my ($json_param) = $mres->content =~ /^My_Animal.omnivore\((.*)?\);$/;
- is_deeply($json->decode($json_param), $monkey_template, "GET returned the right data");
-}
-
-1;
-
-done_testing;
+++ /dev/null
-package Test::Action::Class;
-use Moose;
-
-extends 'Catalyst::Action';
-
-before execute => sub {
- my ($self, $controller, $c, @args) = @_;
- $c->response->header( 'Using-Action' => 'STATION' );
-};
-
-no Moose;
-
-1;
+++ /dev/null
-package Test::Action::Class::Sub;
-use Moose;
-
-extends 'Test::Action::Class';
-
-before execute => sub {
- my ($self, $controller, $c, @args) = @_;
- $c->response->header( 'Using-Sub-Action' => 'MOO' );
-};
-
-no Moose;
-
-1;
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::Actions;
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends qw/Catalyst::Controller::REST/ }
-
-__PACKAGE__->_action_class('Test::Action::Class');
-
-sub begin {} # Don't need serialization..
-
-sub test : Local : ActionClass('+Catalyst::Action::REST') {
- my ( $self, $c ) = @_;
- $c->res->header('X-Was-In-TopLevel', 1);
-}
-
-sub test_GET : Private {
- my ( $self, $c ) = @_;
- $c->res->body('GET');
-}
-
-sub test_POST : Action {
- my ( $self, $c ) = @_;
- $c->res->body('POST');
-}
-
-sub test_PUT :ActionClass('+Test::Action::Class::Sub') {
- my ( $self, $c ) = @_;
- $c->res->body('PUT');
-}
-
-sub test_DELETE : Local {
- my ( $self, $c ) = @_;
- $c->res->body('DELETE');
-}
-
-sub test_OPTIONS : Path('foobar') {
- my ( $self, $c ) = @_;
-
- $c->res->body('OPTIONS');
-}
-
-sub other_test :Local :ActionClass('+Catalyst::Action::REST') {
- my ( $self, $c ) = @_;
- $c->res->header('X-Was-In-TopLevel', 1);
-}
-
-sub other_test_GET {
- my ( $self, $c ) = @_;
- $c->res->body('GET');
-}
-
-sub other_test_POST {
- my ( $self, $c ) = @_;
- $c->res->body('POST');
-}
-
-sub other_test_PUT :ActionClass('+Test::Action::Class::Sub') {
- my ( $self, $c ) = @_;
- $c->res->body('PUT');
-}
-
-sub other_test_DELETE {
- my ( $self, $c ) = @_;
- $c->res->body('DELETE');
-}
-
-sub other_test_OPTIONS {
- my ( $self, $c ) = @_;
-
- $c->res->body('OPTIONS');
-}
-
-sub yet_other_test : Local : ActionClass('+Catalyst::Action::REST') {}
-
-sub yet_other_test_POST {
- my ( $self, $c ) = @_;
- $c->res->body('POST');
-}
-
-sub end : Private {} # Don't need serialization..
-
-1;
-
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::ActionsForBrowsers;
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends qw/Catalyst::Controller::REST/ }
-
-sub begin {} # Don't need serialization..
-
-sub for_browsers : Local : ActionClass('REST::ForBrowsers') {
- my ( $self, $c ) = @_;
- $c->res->header('X-Was-In-TopLevel', 1);
-}
-
-sub for_browsers_GET : Private {
- my ( $self, $c ) = @_;
- $c->res->body('GET');
-}
-
-sub for_browsers_GET_html : Private {
- my ( $self, $c ) = @_;
- $c->res->body('GET_html');
-}
-
-sub for_browsers_POST : Private {
- my ( $self, $c ) = @_;
- $c->res->body('POST');
-}
-
-sub end : Private {} # Don't need serialization..
-
-1;
-
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::Deserialize;
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends 'Catalyst::Controller' }
-
-__PACKAGE__->config(
- 'action_args' => {
- 'test_action_args' => {
- 'deserialize_http_methods' => [qw(POST PUT OPTIONS DELETE GET)]
- }
- },
- 'stash_key' => 'rest',
- 'map' => {
- 'text/x-yaml' => 'YAML',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- 'text/broken' => 'Broken',
- },
-);
-
-
-sub test :Local :ActionClass('Deserialize') {
- my ( $self, $c ) = @_;
- $c->res->output($c->req->data->{'kitty'});
-}
-
-sub test_action_args :Local :ActionClass('Deserialize') {
- my ( $self, $c ) = @_;
- $c->res->output($c->req->data->{'kitty'});
-}
-
-1;
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::DeserializeMultiPart;
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends 'Catalyst::Controller' }
-
-__PACKAGE__->config(
- 'stash_key' => 'rest',
- 'map' => {
- 'text/x-yaml' => 'YAML',
- 'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- 'text/broken' => 'Broken',
- },
-);
-
-sub test :Local ActionClass('DeserializeMultiPart') DeserializePart('REST') {
- my ( $self, $c ) = @_;
- $DB::single=1;
- $c->res->output($c->req->data->{'kitty'} . '|' . $c->req->uploads->{other}->size);
-}
-
-1;
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::Override;
-
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends 'Catalyst::Controller' }
-
-__PACKAGE__->config(
- 'default' => 'application/json',
- 'map' => {
- 'application/json' => 'YAML', # Yes, this is deliberate!
- },
-);
-
-sub test :Local :ActionClass('Serialize') {
- my ( $self, $c ) = @_;
- $c->stash->{'rest'} = {
- lou => 'is my cat',
- };
-}
-
-1;
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::REST;
-
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends 'Catalyst::Controller::REST' }
-
-sub test : Local {
- my ( $self, $c ) = @_;
- $self->status_ok( $c,
- entity => { test => 'worked', data => $c->req->data } );
-}
-
-sub test_status_created : Local {
- my ( $self, $c ) = @_;
- $self->status_created(
- $c,
- location => '/rest',
- entity => { status => 'created' }
- );
-}
-
-sub test_status_multiple_choices : Local {
- my ( $self, $c ) = @_;
- $self->status_multiple_choices(
- $c,
- location => '/rest/choice1',
- entity => { choices => [qw(/rest/choice1 /rest/choice2)] }
- );
-}
-
-sub test_status_found : Local {
- my ( $self, $c ) = @_;
- $self->status_found(
- $c,
- location => '/rest',
- entity => { status => 'found' },
- );
-}
-
-sub test_status_accepted : Local {
- my ( $self, $c ) = @_;
- $self->status_accepted(
- $c,
- location => '/rest',
- entity => { status => "queued", }
- );
-}
-
-sub test_status_no_content : Local {
- my ( $self, $c ) = @_;
- $self->status_no_content($c);
-}
-
-sub test_status_bad_request : Local {
- my ( $self, $c ) = @_;
- $self->status_bad_request( $c,
- message => "Cannot do what you have asked!", );
-}
-
-sub test_status_forbidden : Local {
- my ( $self, $c ) = @_;
- $self->status_forbidden ( $c,
- message => "access denied", );
-}
-
-sub test_status_not_found : Local {
- my ( $self, $c ) = @_;
- $self->status_not_found( $c,
- message => "Cannot find what you were looking for!", );
-}
-
-sub test_status_gone : Local {
- my ( $self, $c ) = @_;
- $self->status_gone( $c,
- message => "Document have been deleted by foo", );
-}
-
-sub opts : Local ActionClass('REST') {}
-
-sub opts_GET {
- my ( $self, $c ) = @_;
- $self->status_ok( $c, entity => { opts => 'worked' } );
-}
-
-sub opts_not_implemented {
- my ( $self, $c ) = @_;
- $c->res->status(405);
- $c->res->header('Allow' => [qw(GET HEAD)]);
- $c->res->body('Not implemented');
-}
-
-1;
+++ /dev/null
-package Test::Catalyst::Action::REST::Controller::Root;
-use Moose;
-use namespace::autoclean;
-
-BEGIN { extends qw/Catalyst::Controller::REST/ }
-
-__PACKAGE__->config( namespace => '' );
-
-sub begin {} # Don't need serialization..
-
-sub test : Local : ActionClass('REST') {
- my ( $self, $c ) = @_;
- $c->stash->{'entity'} = 'something';
-}
-
-sub test_GET {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} .= " GET";
- $c->forward('ok');
-}
-
-sub test_POST {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} .= " POST";
- $c->forward('ok');
-}
-
-sub test_PUT {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} .= " PUT";
- $c->forward('ok');
-}
-
-sub test_DELETE {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} .= " DELETE";
- $c->forward('ok');
-}
-
-sub test_OPTIONS {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} .= " OPTIONS";
- $c->forward('ok');
-}
-
-sub notreally : Local : ActionClass('REST') {
-}
-
-sub notreally_GET {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} = "notreally GET";
- $c->forward('ok');
-}
-
-sub not_implemented : Local : ActionClass('REST') {
-}
-
-sub not_implemented_GET {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} = "not_implemented GET";
- $c->forward('ok');
-}
-
-sub not_implemented_not_implemented {
- my ( $self, $c ) = @_;
-
- $c->stash->{'entity'} = "Not Implemented Handler";
- $c->forward('ok');
-}
-
-sub not_modified : Local : ActionClass('REST') { }
-
-sub not_modified_GET {
- my ( $self, $c ) = @_;
- $c->res->status(304);
- return 1;
-}
-
-sub ok : Private {
- my ( $self, $c ) = @_;
-
- $c->res->content_type('text/plain');
- $c->res->body( $c->stash->{'entity'} );
-}
-
-sub end : Private {} # Don't need serialization..
-
-1;
-
'default' => 'text/x-yaml',
'stash_key' => 'rest',
'map' => {
- 'text/x-yaml' => 'YAML',
- 'application/json' => 'JSON',
'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
- 'text/broken' => 'Broken',
},
);
+++ /dev/null
-package Test::Serialize::Controller::JSON;
-
-use namespace::autoclean;
-use Moose;
-
-BEGIN { extends qw/Catalyst::Controller::REST/ };
-
-__PACKAGE__->config(
- 'stash_key' => 'rest',
- 'json_options' => {
- relaxed => 1,
- },
- 'map' => {
- 'text/x-json' => 'JSON',
- },
-);
-
-sub monkey_json_put : Path("/monkey_json_put") : ActionClass('Deserialize') {
- my ( $self, $c ) = @_;
- if ( ref($c->req->data) eq "HASH" ) {
- my $out = ($c->req->data->{'sushi'}||'') . ($c->req->data->{'chicken'}||'');
- utf8::encode($out);
- $c->res->output( $out );
- } else {
- $c->res->output(1);
- }
-}
-
-1;
'namespace' => '',
'stash_key' => 'rest',
'map' => {
- 'text/html' => 'YAML::HTML',
- 'text/xml' => 'XML::Simple',
- 'text/x-yaml' => 'YAML',
- 'application/json' => 'JSON',
- 'text/x-json' => 'JSON',
'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
'text/x-data-denter' => [ 'Data::Serializer', 'Data::Denter' ],
'text/x-data-taxi' => [ 'Data::Serializer', 'Data::Taxi' ],
[ 'Data::Serializer', 'Config::General' ],
'text/x-php-serialization' =>
[ 'Data::Serializer', 'PHP::Serialization' ],
- 'text/view' => [ 'View', 'Simple' ],
- 'text/explodingview' => [ 'View', 'Awful' ],
- 'text/broken' => 'Broken',
- 'text/javascript', => 'JSONP',
- 'application/x-javascript' => 'JSONP',
- 'application/javascript' => 'JSONP',
- 'text/my-csv' => [
- 'Callback', {
- deserialize => sub { return {split /,/, shift } },
- serialize => sub { my $d = shift; join ',', %$d }
- }
- ],
},
);
+++ /dev/null
-package Test::Serialize::View::Awful;
-
-use base Catalyst::View;
-
-sub render {
- my ($self, $c, $template) = @_;
- die "I don't know how to do that!";
-}
-
-sub process {
- my ($self, $c) = @_;
-
- my $output = eval {
- $self->render($c, "blah");
- };
-
- if ($@) {
- my $error = qq/Couldn't render template. Error: "$@"/;
- $c->error($error);
- return 0;
- }
-
- $c->res->body($output);
- return 1;
-}
-
-1;
+++ /dev/null
-package Test::Serialize::View::Simple;
-use Moose;
-use namespace::autoclean;
-
-extends qw/Catalyst::View/;
-
-sub process {
- my ($self, $c) = @_;
-
- $c->res->body("I am a simple view");
- return 1;
-}
-
-1;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
-use Test::Rest;
-
-use_ok 'Catalyst::Test', 'Test::Serialize';
-
-my $t = Test::Rest->new( 'content_type' => 'text/view' );
-
-my $monkey_template = "I am a simple view";
-my $mres = request( $t->get( url => '/monkey_get' ) );
-ok( $mres->is_success, 'GET the monkey succeeded' );
-is( $mres->content, $monkey_template, "GET returned the right data" );
-
-my $mres_post = request( $t->post( url => '/monkey_put', data => 1 ) );
-ok( $mres_post->is_success, "POST to the monkey passed." );
-
-my $t2 = Test::Rest->new( 'content_type' => 'text/explodingview' );
-my $res = request( $t2->get( url => '/monkey_get' ) );
-
-ok (! $res->is_success, 'View errors result in failure');
-like( $res->content, qr/don't know how/, 'The error looks okay');
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
-use Test::Rest;
-
-use_ok 'Catalyst::Test', 'Test::Serialize';
-
-my $t = Test::Rest->new('content_type' => 'text/xml');
-
-my $has_serializer = eval "require XML::Simple";
-SKIP: {
- skip "XML::Simple not available", 4, unless $has_serializer;
-
- my $xs = XML::Simple->new('ForceArray' => 0);
-
- my $monkey_template = {
- monkey => 'likes chicken!',
- };
- my $mres = request($t->get(url => '/monkey_get'));
- ok( $mres->is_success, 'GET the monkey succeeded' );
- my $output = $xs->XMLin($mres->content);
- is_deeply($xs->XMLin($mres->content)->{'data'}, $monkey_template, "GET returned the right data");
-
- my $post_data = {
- 'sushi' => 'is good for monkey',
- };
- my $mres_post = request($t->post(url => '/monkey_put', data => $xs->XMLout($post_data)));
- ok( $mres_post->is_success, "POST to the monkey succeeded");
- is_deeply($mres_post->content, "is good for monkey", "POST data matches");
-};
-
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use YAML::Syck;
-use FindBin;
-
-use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
-use Test::Rest;
-
-BEGIN {
- use_ok 'Catalyst::Test', 'Test::Serialize';
-}
-
-my $has_serializer = eval "require YAML::Syck";
-SKIP: {
- skip "YAML::Syck not available", 3, unless $has_serializer;
-
- my $t = Test::Rest->new( 'content_type' => 'text/html' );
-
- my $monkey_template =
-"<html><title>Test::Serialize</title><body><pre>--- \nmonkey: likes chicken!\n</pre></body></html>";
- my $mres = request( $t->get( url => '/monkey_get' ) );
- ok( $mres->is_success, 'GET the monkey succeeded' );
- is( $mres->content, $monkey_template, "GET returned the right data" );
-
- my $post_data = { 'sushi' => 'is good for monkey', };
- my $mres_post =
- request( $t->post( url => '/monkey_put', data => Dump($post_data) ) );
- ok( $mres_post->is_error, "POST to the monkey failed; no deserializer." );
-
- # xss test - RT 63537
- my $xss_template =
-"<html><title>Test::Serialize</title><body><pre>--- \nmonkey: likes chicken > sushi!\n</pre></body></html>";
- my $xres = request( $t->get( url => '/xss_get' ) );
- ok( $xres->is_success, 'GET the xss succeeded' );
- is( $xres->content, $xss_template, "GET returned the right data" );
-
-
-}
-1;
-
-done_testing;
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
-use Test::Rest;
-
-use_ok 'Catalyst::Test', 'Test::Serialize';
-
-# Should use the default serializer, YAML
-my $t = Test::Rest->new('content_type' => 'text/x-yaml');
-
-my $has_serializer = eval "require YAML::Syck";
-SKIP: {
- skip "YAML::Syck not available", 4, unless $has_serializer;
-
- # We should use the default serializer, YAML
- my $monkey_template = {
- monkey => 'likes chicken!',
- };
- my $mres = request($t->get(url => '/monkey_get'));
- ok( $mres->is_success, 'GET the monkey succeeded' );
- is_deeply(YAML::Syck::Load($mres->content), $monkey_template, "GET returned the right data");
-
- my $post_data = {
- 'sushi' => 'is good for monkey',
- };
- my $mres_post = request($t->post(url => '/monkey_put', data => YAML::Syck::Dump($post_data)));
- ok( $mres_post->is_success, "POST to the monkey succeeded");
- is_deeply($mres_post->content, "is good for monkey", "POST data matches");
-};
-
-1;
-
-done_testing;
projects / catagits/Catalyst-Action-Serialize-Data-Serializer.git / commitdiff