r49@latte: adam | 2006-12-03 12:30:40 -0800
adam [Sun, 3 Dec 2006 20:27:23 +0000 (20:27 +0000)]
 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.
 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.

27 files changed:
Changelog
lib/Catalyst/Action/Deserialize.pm
lib/Catalyst/Action/Deserialize/Data/Serializer.pm
lib/Catalyst/Action/Deserialize/JSON.pm [new file with mode: 0644]
lib/Catalyst/Action/Deserialize/XML/Simple.pm [new file with mode: 0644]
lib/Catalyst/Action/Deserialize/YAML.pm
lib/Catalyst/Action/Serialize.pm
lib/Catalyst/Action/Serialize/Data/Serializer.pm
lib/Catalyst/Action/Serialize/JSON.pm [new file with mode: 0644]
lib/Catalyst/Action/Serialize/XML/Simple.pm [new file with mode: 0644]
lib/Catalyst/Action/Serialize/YAML.pm
lib/Catalyst/Action/Serialize/YAML/HTML.pm [new file with mode: 0644]
lib/Catalyst/Action/SerializeBase.pm [new file with mode: 0644]
lib/Catalyst/Controller/REST.pm
t/02-data-serializer.t
t/02-json.t [copied from t/01-yaml.t with 65% similarity]
t/02-xml-simple.t [copied from t/01-yaml.t with 60% similarity]
t/02-yaml-html.t [new file with mode: 0644]
t/02-yaml.t [moved from t/01-yaml.t with 100% similarity]
t/broken/Catalyst/Action/Deserialize/Broken.pm [new file with mode: 0644]
t/broken/Catalyst/Action/Serialize/Broken.pm [new file with mode: 0644]
t/catalyst-action-deserialize.t [new file with mode: 0644]
t/catalyst-action-serialize-accept.t [new file with mode: 0644]
t/catalyst-action-serialize-query.t [new file with mode: 0644]
t/catalyst-action-serialize.t [new file with mode: 0644]
t/lib/Test/Rest.pm
t/lib/Test/Serialize.pm [new file with mode: 0644]

index b461037..14957b9 100644 (file)
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,12 @@
+Sun Dec  3 12:24:16 PST 2006 (adam)
+       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
index 8b23cf7..653a93f 100644 (file)
@@ -9,7 +9,7 @@ package Catalyst::Action::Deserialize;
 use strict;
 use warnings;
 
-use base 'Catalyst::Action';
+use base 'Catalyst::Action::SerializeBase';
 use Module::Pluggable::Object;
 use Catalyst::Request::REST;
 
@@ -17,55 +17,32 @@ __PACKAGE__->mk_accessors(qw(plugins));
 
 sub execute {
     my $self = shift;
-    my ( $controller, $c, $test ) = @_;
+    my ( $controller, $c ) = @_;
 
     my $nreq = bless( $c->request, 'Catalyst::Request::REST' );
     $c->request($nreq);
 
-    unless ( defined( $self->plugins ) ) {
-        my $mpo = Module::Pluggable::Object->new(
-            'require'     => 1,
-            'search_path' => ['Catalyst::Action::Deserialize'],
-        );
-        my @plugins = $mpo->plugins;
-        $self->plugins( \@plugins );
-    }
-    my $content_type = $c->request->content_type;
-    my $sclass       = 'Catalyst::Action::Deserialize::';
-    my $sarg;
-    my $map = $controller->serialize->{'map'};
-    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};
-        }
-        $sclass .= $mc;
-        if ( !grep( /^$sclass$/, @{ $self->plugins } ) ) {
-            die "Cannot find plugin $sclass for $content_type!";
-        }
-    } else {
-        if ( exists( $controller->serialize->{'default'} ) ) {
-            $sclass .= $controller->serialize->{'default'};
-        } else {
-            die "I cannot find a default serializer!";
-        }
-    }
-
     my @demethods = qw(POST PUT OPTIONS);
     my $method    = $c->request->method;
     if ( grep /^$method$/, @demethods ) {
+        my ($sclass, $sarg, $content_type) = $self->_load_content_plugins('Catalyst::Action::Deserialize', $controller, $c);        
+        return 1 unless defined ($sclass);
+        my $rc;
         if ( defined($sarg) ) {
-            $sclass->execute( $controller, $c, $sarg );
+            $rc = $sclass->execute( $controller, $c, $sarg );
         } else {
-            $sclass->execute( $controller, $c );
+            $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->NEXT::execute( @_, );
-    } else {
-        $self->NEXT::execute(@_);
-    }
+    } 
+
+    $self->NEXT::execute( @_ );
+
+    return 1;
 }
 
 =head1 NAME
@@ -87,7 +64,7 @@ Catalyst::Action::Deserialize - Deserialize Data in a Request
         }
     );
 
-    sub begin : ActionClass('Deserialize') {}
+    sub begin :ActionClass('Deserialize') {}
 
 =head1 DESCRIPTION
 
@@ -97,7 +74,7 @@ The serializer is selected by introspecting the requests content-type
 header.
 
 It requires that your Catalyst controller have a "serialize" entry
-in it's configuration.
+in it's configuration.  See L<Catalyst::Action::Serialize> for the details.
 
 The specifics of deserializing each content-type is implemented as
 a plugin to L<Catalyst::Action::Deserialize>.  You can see a list
@@ -106,20 +83,13 @@ 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>.
 
-=head1 CONFIGURATION
-
-=over 4
-
-=item default
-
-The default Serialization format.  See the next section for
-available options.
-
-=item map
+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:
 
-Takes a hashref, mapping Content-Types to a given plugin.
+   sub foo :Local :Action('Deserialize') {}
 
-=back
+Will work just fine.
 
 =head1 SEE ALSO
 
index ef43574..7044655 100644 (file)
@@ -17,6 +17,16 @@ sub execute {
     my $self = shift;
     my ( $controller, $c, $serializer ) = @_;
 
+    my $sp = $serializer;
+    $sp =~ s/::/\//g;
+    $sp .= ".pm";
+    eval {
+        require $sp
+    };
+    if ($@) {
+        $c->log->debug("Could not load $serializer, refusing to serialize: $@");
+        return 0;
+    }
     my $body = $c->request->body;
     if ($body) {
         my $rbody;
@@ -28,12 +38,19 @@ sub execute {
             close(BODY);
         }
         my $dso = Data::Serializer->new( serializer => $serializer );
-        my $rdata = $dso->raw_deserialize($rbody);
+        my $rdata;
+        eval {
+            $rdata = $dso->raw_deserialize($rbody);
+        };
+        if ($@) {
+            return $@;
+        }
         $c->request->data($rdata);
     } else {
         $c->log->debug(
             'I would have deserialized, but there was nothing in the body!');
     }
+    return 1;
 }
 
 1;
diff --git a/lib/Catalyst/Action/Deserialize/JSON.pm b/lib/Catalyst/Action/Deserialize/JSON.pm
new file mode 100644 (file)
index 0000000..560bf24
--- /dev/null
@@ -0,0 +1,41 @@
+#
+# Catlyst::Action::Deserialize::JSON.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Deserialize::JSON;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use JSON::Syck;
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c, $test ) = @_;
+
+    my $body = $c->request->body;
+    if ($body) {
+        my $rdata;
+        my $rbody;
+        while (my $line = <$body>) {
+            $rbody .= $line;
+        }
+        eval {
+            $rdata = JSON::Syck::Load( $rbody );
+        };
+        if ($@) {
+            return $@;
+        }
+        $c->request->data($rdata);
+    } else {
+        $c->log->debug(
+            'I would have deserialized, but there was nothing in the body!');
+    }
+    return 1;
+}
+
+1;
diff --git a/lib/Catalyst/Action/Deserialize/XML/Simple.pm b/lib/Catalyst/Action/Deserialize/XML/Simple.pm
new file mode 100644 (file)
index 0000000..6e97d72
--- /dev/null
@@ -0,0 +1,49 @@
+#
+# Catlyst::Action::Deserialize::XML::Simple.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Deserialize::XML::Simple;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+
+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: $@");
+        return 0;
+    }
+
+    my $body = $c->request->body;
+    if ($body) {
+        my $xs = XML::Simple->new('ForceArray' => 0,);
+        my $rdata;
+        eval {
+            $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!');
+    }
+    return 1;
+}
+
+1;
index b972830..84630f4 100644 (file)
@@ -19,12 +19,19 @@ sub execute {
 
     my $body = $c->request->body;
     if ($body) {
-        my $rdata = LoadFile( $c->request->body );
+        my $rdata;
+        eval {
+            $rdata = LoadFile( $c->request->body );
+        };
+        if ($@) {
+            return $@;
+        }
         $c->request->data($rdata);
     } else {
         $c->log->debug(
             'I would have deserialized, but there was nothing in the body!');
     }
+    return 1;
 }
 
 1;
index 313ba80..10cf82e 100644 (file)
@@ -9,67 +9,35 @@ package Catalyst::Action::Serialize;
 use strict;
 use warnings;
 
-use base 'Catalyst::Action';
+use base 'Catalyst::Action::SerializeBase';
 use Module::Pluggable::Object;
-
-__PACKAGE__->mk_accessors(qw(plugins));
+use Data::Dump qw(dump);
 
 sub execute {
     my $self = shift;
     my ( $controller, $c ) = @_;
 
+    $self->NEXT::execute( @_ );
+
     return 1 if $c->req->method eq 'HEAD';
     return 1 if length( $c->response->body );
     return 1 if scalar @{ $c->error };
     return 1 if $c->response->status =~ /^(?:204|3\d\d)$/;
 
-    # Load the Serialize Classes
-    unless ( defined( $self->plugins ) ) {
-        my $mpo = Module::Pluggable::Object->new(
-            'require'     => 1,
-            'search_path' => ['Catalyst::Action::Serialize'],
-        );
-        my @plugins = $mpo->plugins;
-        $self->plugins( \@plugins );
-    }
-
-    # Look up what serializer to use from content_type map
-    #
-    # If we don't find one, we use the default
-    my $content_type = $c->request->content_type;
-    my $sclass       = 'Catalyst::Action::Serialize::';
-    my $sarg;
-    my $map = $controller->serialize->{'map'};
-    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};
-        }
-        $sclass .= $mc;
-        if ( !grep( /^$sclass$/, @{ $self->plugins } ) ) {
-            die "Cannot find plugin $sclass for $content_type!";
-        }
-    } else {
-        if ( exists( $controller->serialize->{'default'} ) ) {
-            $sclass .= $controller->serialize->{'default'};
-        } else {
-            die "I cannot find a default serializer!";
-        }
-    }
+    my ($sclass, $sarg, $content_type) = $self->_load_content_plugins("Catalyst::Action::Serialize", $controller, $c);
+    return 1 unless defined $sclass;
 
-    # Go ahead and serialize ourselves
+    my $rc;
     if ( defined($sarg) ) {
-        $sclass->execute( $controller, $c, $sarg );
+        $rc = $sclass->execute( $controller, $c, $sarg );
     } else {
-        $sclass->execute( $controller, $c );
-    }
-
-    if ( !$c->response->content_type ) {
-        $c->response->content_type( $c->request->content_type );
+        $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);
+    } 
 
     return 1;
 }
@@ -95,19 +63,27 @@ Catalyst::Action::Serialize - Serialize Data in a Response
         }
     );
 
-    sub end : ActionClass('Serialize') {}
+    sub end :ActionClass('Serialize') {}
 
 =head1 DESCRIPTION
 
 This action will serialize the body of an HTTP Response.  The serializer is
-selected by introspecting the requests content-type header.
+selected by introspecting the HTTP Requests content-type header.
 
 It requires that your Catalyst controller have a "serialize" entry
-in it's configuration.
+in it's configuration, which sets 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 ..
+  }
+
 =head1 CONFIGURATION
 
 =over 4
@@ -120,7 +96,10 @@ is not recognized.
 
 =item stash_key 
 
-Where in the stash the data you want serialized lives.
+We will serialize the data that lives in this location in the stash.  So
+if the value is "rest", we will serialize the data under:
+
+  $c->stash->{'rest'}
 
 =item map
 
@@ -128,10 +107,16 @@ Takes a hashref, mapping Content-Types to a given plugin.
 
 =back
 
+=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 SEE ALSO
 
 You likely want to look at L<Catalyst::Controller::REST>, which implements
-a sensible set of defaults for a controller doing REST.
+a sensible set of defaults for doing a REST controller.
 
 L<Catalyst::Action::Deserialize>, L<Catalyst::Action::REST>
 
index 138fd36..7297fcd 100644 (file)
@@ -16,9 +16,26 @@ sub execute {
     my $self = shift;
     my ( $controller, $c, $serializer ) = @_;
 
-    my $stash_key = $controller->serialize->{'stash_key'} || 'rest';
+    my $stash_key = $controller->config->{'serialize'}->{'stash_key'} || 'rest';
+    my $sp = $serializer;
+    $sp =~ s/::/\//g;
+    $sp .= ".pm";
+    eval {
+        require $sp
+    };
+    if ($@) {
+        $c->log->debug("Could not load $serializer, refusing to serialize: $@");
+        return 0;
+    }
     my $dso = Data::Serializer->new( serializer => $serializer );
-    $c->response->output( $dso->raw_serialize( $c->stash->{$stash_key} ) );
+    my $data;
+    eval {
+       $data = $dso->raw_serialize($c->stash->{$stash_key});
+    };
+    if ($@) {
+        return $@;
+    } 
+    $c->response->output( $data );
     return 1;
 }
 
diff --git a/lib/Catalyst/Action/Serialize/JSON.pm b/lib/Catalyst/Action/Serialize/JSON.pm
new file mode 100644 (file)
index 0000000..8a74a3e
--- /dev/null
@@ -0,0 +1,32 @@
+#
+# Catlyst::Action::Serialize::JSON.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Serialize::JSON;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use JSON::Syck;
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c ) = @_;
+
+    my $stash_key = $controller->config->{'serialize'}->{'stash_key'} || 'rest';
+    my $output;
+    eval {
+        $output = JSON::Syck::Dump($c->stash->{$stash_key});
+    };
+    if ($@) {
+        return $@;
+    }
+    $c->response->output( $output );
+    return 1;
+}
+
+1;
diff --git a/lib/Catalyst/Action/Serialize/XML/Simple.pm b/lib/Catalyst/Action/Serialize/XML/Simple.pm
new file mode 100644 (file)
index 0000000..de297d2
--- /dev/null
@@ -0,0 +1,40 @@
+#
+# Catlyst::Action::Serialize::XML::Simple.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Serialize::XML::Simple;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c ) = @_;
+
+    eval {
+        require XML::Simple
+    };
+    if ($@) {
+        $c->log->debug("Could not load XML::Serializer, refusing to serialize: $@");
+        return 0;
+    }
+    my $xs = XML::Simple->new(ForceArray => 0,);
+
+    my $stash_key = $controller->config->{'serialize'}->{'stash_key'} || 'rest';
+    my $output;
+    eval {
+        $output = $xs->XMLout({ data => $c->stash->{$stash_key} });
+    };
+    if ($@) {
+        return $@;
+    }
+    $c->response->output( $output );
+    return 1;
+}
+
+1;
index ec328ca..3856250 100644 (file)
@@ -15,10 +15,17 @@ use YAML::Syck;
 
 sub execute {
     my $self = shift;
-    my ( $controller, $c, $test ) = @_;
+    my ( $controller, $c ) = @_;
 
-    my $stash_key = $controller->serialize->{'stash_key'} || 'rest';
-    $c->response->output( Dump( $c->stash->{$stash_key} ) );
+    my $stash_key = $controller->config->{'serialize'}->{'stash_key'} || 'rest';
+    my $output;
+    eval {
+        $output = Dump($c->stash->{$stash_key});
+    };
+    if ($@) {
+        return $@;
+    }
+    $c->response->output( $output );
     return 1;
 }
 
diff --git a/lib/Catalyst/Action/Serialize/YAML/HTML.pm b/lib/Catalyst/Action/Serialize/YAML/HTML.pm
new file mode 100644 (file)
index 0000000..93a95d3
--- /dev/null
@@ -0,0 +1,42 @@
+#
+# Catlyst::Action::Serialize::YAML::HTML.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Serialize::YAML::HTML;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use YAML::Syck;
+use URI::Find;
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c ) = @_;
+
+    my $stash_key = $controller->config->{'serialize'}->{'stash_key'} || 'rest';
+    my $app = $c->config->{'name'} || '';
+    my $output = "<html>";
+    $output .= "<title>" . $app . "</title>";
+    $output .= "<body><pre>";
+    my $text = Dump($c->stash->{$stash_key});
+    # Straight from URI::Find
+    my $finder = URI::Find->new(
+                              sub {
+                                  my($uri, $orig_uri) = @_;
+                                  return qq|<a href="$uri">$orig_uri</a>|;
+                              });
+    $finder->find(\$text);
+    $output .= $text;
+    $output .= "</pre>";
+    $output .= "</body>";
+    $output .= "</html>";
+    $c->response->output( $output );
+    return 1;
+}
+
+1;
diff --git a/lib/Catalyst/Action/SerializeBase.pm b/lib/Catalyst/Action/SerializeBase.pm
new file mode 100644 (file)
index 0000000..e26152b
--- /dev/null
@@ -0,0 +1,190 @@
+#
+# Catlyst::Action::SerializeBase.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+#
+# $Id$
+
+package Catalyst::Action::SerializeBase;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use Module::Pluggable::Object;
+use Data::Dump qw(dump);
+use HTTP::Headers::Util qw(split_header_words);
+
+__PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins));
+
+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 );
+    }
+
+    # First, we use the content type in the HTTP Request.  It wins all.
+    my $content_type = $c->request->content_type || '';
+
+    # Second, we allow GET requests to tunnel the content-type as
+    #  a query param.
+    if (!$content_type && $c->req->method eq "GET" && $c->req->param('content-type')) {
+
+        $content_type = $c->req->param('content-type');
+    }
+
+    # Third, we parse the Accept header, and see if the client
+    # takes a format we understand.
+    #
+    # This is taken from chansen's Apache2::UploadProgress.
+    my $used_accept = 0;
+    if ( !$content_type && $c->request->header('Accept') ) {
+        my $accept_header = $c->request->header('Accept');
+        my %accept        = ();
+        my $counter       = 0;
+
+        foreach my $pair ( split_header_words($accept_header) ) {
+
+            my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
+
+            unless ( defined $qvalue ) {
+                $qvalue = 1 - ( ++$counter / 1000 );
+            }
+
+            $accept{$type} = sprintf( '%.3f', $qvalue );
+        }
+
+        foreach my $type ( sort { $accept{$b} <=> $accept{$a} } keys %accept )
+        {
+
+            if ( exists $controller->config->{'serialize'}->{'map'}->{$type} )
+            {
+                $content_type = $type;
+                last;
+            }
+        }
+        $used_accept = 1;
+    }
+
+    # 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 = $controller->config->{'serialize'}->{'map'};
+    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 {
+        if ( exists( $controller->config->{'serialize'}->{'default'} ) ) {
+            $sclass .= $controller->config->{'serialize'}->{'default'};
+        } 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 . ": $!" )
+              if $c->log->is_debug;
+            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 ($used_accept) {
+            $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)) {
+        $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;
+}
+
+1;
+
+=head1 NAME
+
+B<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 AUTHOR
+
+Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway.
+
+Marchex, Inc. paid me while I developed this module.  (http://www.marchex.com)
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
index 892fb9b..1017cb1 100644 (file)
@@ -49,16 +49,25 @@ 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. 
+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 deserialize the
 contents of $c->request->body based on the requests content-type header.
 A list of understood serialization formats is below.
 
-Also included in this class are several helper methods, which
-will automatically handle setting up proper response objects 
-for you.
+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
 
@@ -67,22 +76,117 @@ To make your Controller RESTful, simply have it
 =head1 SERIALIZATION
 
 Catalyst::Controller::REST will automatically serialize your
-responses.  The currently implemented serialization formats are:
+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 2
+
+=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 it's quirks in terms of what sorts of data
+structures it will properly handle.  L<Catalyst::Controller::REST> makes
+no attempt to svae 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 useable for Serialization.
+
+=item C<text/x-json> => C<JSON::Syck>
+
+Uses L<JSON::Syck> to generate JSON output
+
+=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<application/x-storable> => C<Data::Serializer>
+
+Uses the L<Data::Serializer> module to generate L<Storable> output.
+
+=item C<application/x-freezethaw> => C<Data::Serializer>
+
+Uses the L<Data::Serializer> module to generate L<FreezeThaw> 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 }
+
+=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:
 
-   text/x-yaml        ->   YAML::Syck
-   text/x-data-dumper ->   Data::Serializer
+   __PACKAGE__->config->{'serialize'}->{'default'} = 'YAML';
 
-By default, L<Catalyst::Controller::REST> will use YAML as
-the serialization format.
+Would make it always fall back to YAML.
 
 Implementing new Serialization formats is easy!  Contributions
 are most welcome!  See L<Catalyst::Action::Serialize> and
 L<Catalyst::Action::Deserialize> for more information.
 
+=head1 CUSTOM SERIALIZERS
+
+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.
+
 =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: http://www.w3.org/Protocols/rfc2616/rfc2616.txt.  
+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.
 
@@ -99,19 +203,28 @@ __PACKAGE__->mk_accessors(qw(serialize));
 
 __PACKAGE__->config(
     serialize => {
-        'default'   => 'YAML',
         'stash_key' => 'rest',
         'map'       => {
+            'text/html'          => 'YAML::HTML',
+            'text/xml'           => 'XML::Simple',
             'text/x-yaml'        => 'YAML',
+            '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' ],
         },
     }
 );
 
+sub begin : ActionClass('Deserialize') {
+}
 
-sub begin : ActionClass('Deserialize') {}
-
-sub end : ActionClass('Serialize') { }
+sub end : ActionClass('Serialize') {
+}
 
 =item status_ok
 
@@ -130,15 +243,11 @@ Example:
 
 sub status_ok {
     my $self = shift;
-    my $c = shift;
-    my %p = validate(@_,
-        {
-            entity => 1, 
-        },
-    );
+    my $c    = shift;
+    my %p    = validate( @_, { entity => 1, }, );
 
     $c->response->status(200);
-    $self->_set_entity($c, $p{'entity'});
+    $self->_set_entity( $c, $p{'entity'} );
     return 1;
 }
 
@@ -164,23 +273,24 @@ This is probably what you want for most PUT requests.
 
 sub status_created {
     my $self = shift;
-    my $c = shift;
-    my %p = validate(@_,
+    my $c    = shift;
+    my %p    = validate(
+        @_,
         {
-            location => { type => SCALAR | OBJECT },
-            entity => { optional => 1 }, 
+            location => { type     => SCALAR | OBJECT },
+            entity   => { optional => 1 },
         },
     );
 
     my $location;
-    if (ref($p{'location'})) {
+    if ( ref( $p{'location'} ) ) {
         $location = $p{'location'}->as_string;
     } else {
         $location = $p{'location'};
     }
     $c->response->status(201);
-    $c->response->header('Location' => $location);
-    $self->_set_entity($c, $p{'entity'});
+    $c->response->header( 'Location' => $location );
+    $self->_set_entity( $c, $p{'entity'} );
     return 1;
 }
 
@@ -198,17 +308,14 @@ Example:
   );
 
 =cut
+
 sub status_accepted {
     my $self = shift;
-    my $c = shift;
-    my %p = validate(@_,
-        {
-            entity => 1, 
-        },
-    );
+    my $c    = shift;
+    my %p    = validate( @_, { entity => 1, }, );
 
     $c->response->status(202);
-    $self->_set_entity($c, $p{'entity'});
+    $self->_set_entity( $c, $p{'entity'} );
     return 1;
 }
 
@@ -226,18 +333,15 @@ Example:
   );
 
 =cut
+
 sub status_bad_request {
     my $self = shift;
-    my $c = shift;
-    my %p = validate(@_,
-        {
-            message => { type => SCALAR }, 
-        },
-    );
+    my $c    = shift;
+    my %p    = validate( @_, { message => { type => SCALAR }, }, );
 
     $c->response->status(400);
-    $c->log->debug("Status Bad Request: " . $p{'message'});
-    $self->_set_entity($c, { error => $p{'message'} });
+    $c->log->debug( "Status Bad Request: " . $p{'message'} );
+    $self->_set_entity( $c, { error => $p{'message'} } );
     return 1;
 }
 
@@ -255,27 +359,24 @@ Example:
   );
 
 =cut
+
 sub status_not_found {
     my $self = shift;
-    my $c = shift;
-    my %p = validate(@_,
-        {
-            message => { type => SCALAR }, 
-        },
-    );
+    my $c    = shift;
+    my %p    = validate( @_, { message => { type => SCALAR }, }, );
 
     $c->response->status(404);
-    $c->log->debug("Status Not Found: " . $p{'message'});
-    $self->_set_entity($c, { error => $p{'message'} });
+    $c->log->debug( "Status Not Found: " . $p{'message'} );
+    $self->_set_entity( $c, { error => $p{'message'} } );
     return 1;
 }
 
 sub _set_entity {
-    my $self = shift;
-    my $c = shift;
+    my $self   = shift;
+    my $c      = shift;
     my $entity = shift;
-    if (defined($entity)) {
-        $c->stash->{$self->config->{'serialize'}->{'stash_key'}} = $entity;
+    if ( defined($entity) ) {
+        $c->stash->{ $self->config->{'serialize'}->{'stash_key'} } = $entity;
     }
     return 1;
 }
@@ -287,6 +388,73 @@ sub _set_entity {
 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(
+      serialize => {
+         'stash_key' => 'rest',
+         'map'       => {
+            'text/html'          => 'YAML::HTML',
+            'text/xml'           => 'XML::Simple',
+            'text/x-yaml'        => 'YAML',
+            '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::Serializat
+ion' ],
+          },
+      }
+  );
+
+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 use NEXT:
+
+  my Foo::Controller::Monkey;
+  use base qw(Catalyst::Controller::REST);
+
+  sub begin :Private {
+    my ($self, $c) = @_;
+    ... do things before Deserializing ...
+    $self->NEXT::begin($c); 
+    ... do things after Deserializing ...
+  } 
+
+  sub end :Private {
+    my ($self, $c) = @_;
+    ... do things before Serializing ...
+    $self->NEXT::end($c); 
+    ... do things after Serializing ...
+  }
+
+=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 unneccesarily. :)
+
 =head1 SEE ALSO
 
 L<Catalyst::Action::REST>, L<Catalyst::Action::Serialize>,
index ffb8cdd..740a24e 100644 (file)
@@ -1,34 +1,62 @@
 use strict;
 use warnings;
 use Test::More qw(no_plan);
-use Data::Serializer;
 use FindBin;
 
-use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
+use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
 use Test::Rest;
 
-my $dso = Data::Serializer->new(serializer => 'Data::Dumper');
-
-# Should use Data::Dumper, via Data::Serializer 
-my $t = Test::Rest->new('content_type' => 'text/x-data-dumper');
-
-BEGIN { use_ok 'Catalyst::Test', 'SampleREST' }
-
-my $mres = request($t->get(url => '/monkey'));
-# We should find the monkey
-ok( $mres->is_success, 'GET the monkey succeeded' );
-
-my $monkey_template = {
-    monkey => 'likes chicken!',
-};
-my $monkey_data = $dso->raw_deserialize($mres->content); 
-is_deeply($monkey_data, $monkey_template, "GET returned the right data");
-
-my $post_data = {
-    'sushi' => 'is good for monkey',
-};
-my $mres_post = request($t->post(url => '/monkey', data => $dso->raw_serialize($post_data)));
-ok( $mres_post->is_success, "POST to the monkey succeeded");
-is_deeply($mres_post->content, $dso->raw_serialize($post_data), "POST data matches");
+use_ok 'Catalyst::Test', 'Test::Serialize';
+
+my %ctypes =( 
+            'text/x-data-dumper' =>   'Data::Dumper' ,
+            'text/x-data-denter' =>   'Data::Denter' ,
+            'text/x-data-taxi'   =>   'Data::Taxi'   ,
+            'application/x-storable'    =>   'Storable'     ,
+            'application/x-freezethaw'  =>   'FreezeThaw'   ,
+            'text/x-config-general' =>   'Config::General' ,
+            'text/x-php-serialization' =>   'PHP::Serialization' ,
+        );
+
+my $has_serializer = eval "require Data::Serializer";
+
+foreach my $content_type (keys(%ctypes)) {
+    my $dso;
+    my $skip = 0;
+    my $loadclass = $ctypes{$content_type};
+    $loadclass =~ s/::/\//g;
+    $loadclass .= '.pm';
+    eval {
+       require $loadclass 
+    };
+    if ($@) {
+        $skip = 1;
+    }
+    SKIP: {
+        skip "$ctypes{$content_type} not installed", 4 if $skip;
+        $dso = Data::Serializer->new( serializer => $ctypes{$content_type} );
+        my $t = Test::Rest->new( 'content_type' => $content_type );
+
+        my $monkey_template = { monkey => 'likes chicken!', };
+        my $mres = request( $t->get( url => '/monkey_get' ) );
+        ok( $mres->is_success, "GET $content_type succeeded" );
+        is_deeply( $dso->raw_deserialize( $mres->content ),
+            $monkey_template, "GET $content_type has the right data" );
+
+        my $post_data = { 'sushi' => 'is good for monkey', };
+        my $mres_post = request(
+            $t->post(
+                url  => '/monkey_put',
+                data => $dso->raw_serialize($post_data)
+            )
+        );
+        ok( $mres_post->is_success, "POST $content_type succeeded" );
+        is_deeply(
+            $mres_post->content,
+            "is good for monkey",
+            "POST $content_type data matches"
+        );
+    }
+}
 
 1;
similarity index 65%
copy from t/01-yaml.t
copy to t/02-json.t
index 7559615..2cbf35d 100644 (file)
@@ -8,25 +8,23 @@ 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 $t = Test::Rest->new('content_type' => 'text/x-json');
 
-my $has_serializer = eval "require YAML::Syck";
+my $has_serializer = eval "require JSON::Syck";
 SKIP: {
-    skip "YAML::Syck not available", 4, unless $has_serializer;
+    skip "JSON::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");
+    is_deeply(JSON::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)));
+    my $mres_post = request($t->post(url => '/monkey_put', data => JSON::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");
 };
similarity index 60%
copy from t/01-yaml.t
copy to t/02-xml-simple.t
index 7559615..ccc9c00 100644 (file)
@@ -2,31 +2,33 @@ use strict;
 use warnings;
 use Test::More qw(no_plan);
 use FindBin;
+use Data::Dump qw(dump);
 
 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 $t = Test::Rest->new('content_type' => 'text/xml');
 
-my $has_serializer = eval "require YAML::Syck";
+my $has_serializer = eval "require XML::Simple";
 SKIP: {
-    skip "YAML::Syck not available", 4, unless $has_serializer;
+    skip "XML::Simple not available", 4, unless $has_serializer;
+    
+    my $xs = XML::Simple->new('ForceArray' => 0);
 
-    # 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 $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 => YAML::Syck::Dump($post_data)));
+    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");
 };
diff --git a/t/02-yaml-html.t b/t/02-yaml-html.t
new file mode 100644 (file)
index 0000000..fc6fa03
--- /dev/null
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use YAML::Syck;
+use FindBin;
+use Data::Dump qw(dump);
+
+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." );
+
+}
+1;
similarity index 100%
rename from t/01-yaml.t
rename to t/02-yaml.t
diff --git a/t/broken/Catalyst/Action/Deserialize/Broken.pm b/t/broken/Catalyst/Action/Deserialize/Broken.pm
new file mode 100644 (file)
index 0000000..783aa13
--- /dev/null
@@ -0,0 +1,9 @@
+package Catalyst::Action::Serializer::Broken;
+
+use strict;
+use warnings;
+
+use Bilbo::Baggins;
+
+1;
+
diff --git a/t/broken/Catalyst/Action/Serialize/Broken.pm b/t/broken/Catalyst/Action/Serialize/Broken.pm
new file mode 100644 (file)
index 0000000..783aa13
--- /dev/null
@@ -0,0 +1,9 @@
+package Catalyst::Action::Serializer::Broken;
+
+use strict;
+use warnings;
+
+use Bilbo::Baggins;
+
+1;
+
diff --git a/t/catalyst-action-deserialize.t b/t/catalyst-action-deserialize.t
new file mode 100644 (file)
index 0000000..b524b48
--- /dev/null
@@ -0,0 +1,62 @@
+package Test::Catalyst::Action::Deserialize;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config(
+    name => 'Test::Catalyst::Action::Deserialize',
+    serialize => {
+        'stash_key' => 'rest',
+        'map'       => {
+            'text/x-yaml'        => 'YAML',
+            'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+            'text/broken'        => 'Broken',
+        },
+    }
+);
+
+__PACKAGE__->setup;
+
+sub test :Local :ActionClass('Deserialize') {
+    my ( $self, $c ) = @_;
+    $c->res->output($c->req->data->{'kitty'});
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use YAML::Syck;
+use FindBin;
+use Data::Dump qw(dump);
+
+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::Deserialize';
+
+my $res = request($t->put( url => '/test', data => Dump({ kitty => "LouLou" })));
+ok( $res->is_success, 'PUT Deserialize request succeeded' );
+is( $res->content, "LouLou", "Request returned deserialized data");
+
+my $nt = Test::Rest->new('content_type' => 'text/broken');
+my $bres = request($nt->put( url => '/test', 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 => '/test', data => Dump({ kitty => "LouLou" })));
+is ($bres->code, 415, 'GET on unknown Content-Type returns 415');
+
+1;
diff --git a/t/catalyst-action-serialize-accept.t b/t/catalyst-action-serialize-accept.t
new file mode 100644 (file)
index 0000000..176c5e9
--- /dev/null
@@ -0,0 +1,70 @@
+package Test::Catalyst::Action::Serialize;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config(
+    name => 'Test::Catalyst::Action::Serialize',
+    serialize => {
+        'stash_key' => 'rest',
+        'map'       => {
+            'text/x-yaml'        => 'YAML',
+            'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+            'text/broken'        => 'Broken',
+        },
+    }
+);
+
+__PACKAGE__->setup;
+
+sub test :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = {
+        lou => 'is my cat',
+    };
+}
+
+sub test_second :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = {
+        lou => 'is my cat',
+    };
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use Data::Serializer;
+use FindBin;
+use Data::Dump qw(dump);
+
+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-yaml');
+
+use_ok 'Catalyst::Test', 'Test::Catalyst::Action::Serialize';
+
+my $req = $t->get(url => '/test');
+$req->remove_header('Content-Type');
+$req->header('Accept', 'text/x-yaml');
+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;
diff --git a/t/catalyst-action-serialize-query.t b/t/catalyst-action-serialize-query.t
new file mode 100644 (file)
index 0000000..e2e6f96
--- /dev/null
@@ -0,0 +1,61 @@
+package Test::Catalyst::Action::Serialize;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config(
+    name => 'Test::Catalyst::Action::Serialize',
+    serialize => {
+        'stash_key' => 'rest',
+        'map'       => {
+            'text/x-yaml'        => 'YAML',
+            'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+            'text/broken'        => 'Broken',
+        },
+    }
+);
+
+__PACKAGE__->setup;
+
+sub test :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = {
+        lou => 'is my cat',
+    };
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use FindBin;
+use Data::Dump qw(dump);
+
+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::Serialize';
+
+my $req = $t->get(url => '/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;
diff --git a/t/catalyst-action-serialize.t b/t/catalyst-action-serialize.t
new file mode 100644 (file)
index 0000000..98ac990
--- /dev/null
@@ -0,0 +1,79 @@
+package Test::Catalyst::Action::Serialize;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config(
+    name => 'Test::Catalyst::Action::Serialize',
+    serialize => {
+        'default'   => 'YAML',
+        'stash_key' => 'rest',
+        'map'       => {
+            'text/x-yaml'        => 'YAML',
+            'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+            'text/broken'        => 'Broken',
+        },
+    }
+);
+
+__PACKAGE__->setup;
+
+sub test :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = {
+        lou => 'is my cat',
+    };
+}
+
+sub test_second :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = {
+        lou => 'is my cat',
+    };
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use Data::Serializer;
+use FindBin;
+use Data::Dump qw(dump);
+
+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::Serialize';
+
+my $res = request($t->get(url => '/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 => '/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 => '/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 => '/test_second'));
+ok( $res2->is_success, '2nd request succeeded' );
+is( $res2->content, "{'lou' => 'is my cat'}", "2nd request returned proper data");
+
+
+1;
index bb748e9..5892aa5 100644 (file)
@@ -15,7 +15,10 @@ use Params::Validate qw(:all);
 
 sub new {
     my $self = shift;
-    my %p    = validate( @_, { content_type => { type => SCALAR }, }, );
+    my %p    = validate( @_, { 
+            content_type => { type => SCALAR }, 
+        }, 
+    );
     my $ref  = {
         'ua'           => LWP::UserAgent->new,
         'content_type' => $p{'content_type'},
diff --git a/t/lib/Test/Serialize.pm b/t/lib/Test/Serialize.pm
new file mode 100644 (file)
index 0000000..f549e77
--- /dev/null
@@ -0,0 +1,48 @@
+package Test::Serialize;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config(
+    name => 'Test::Serialize',
+    serialize => {
+        'stash_key' => 'rest',
+        'map'       => {
+            'text/html'          => 'YAML::HTML',
+            'text/xml'           => 'XML::Simple',
+            'text/x-yaml'        => 'YAML',
+            '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' ],
+            'text/broken'        => 'Broken',
+        },
+    }
+);
+
+__PACKAGE__->setup;
+
+sub monkey_put :Local :ActionClass('Deserialize') {
+    my ( $self, $c ) = @_;
+    $c->res->output($c->req->data->{'sushi'});
+}
+
+sub monkey_get :Local :ActionClass('Serialize') {
+    my ( $self, $c ) = @_;
+    $c->stash->{'rest'} = { monkey => 'likes chicken!', };
+}
+
+1;
+