From: Tomas Doran <bobtfish@bobtfish.net>
Date: Fri, 11 Dec 2009 02:50:39 +0000 (+0000)
Subject: Mangle the request class mangling stuff. It's still fugly, but it's no longer totally... 
X-Git-Tag: 0.80~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Action-REST.git;a=commitdiff_plain;h=149182b33984f338616305abf6438822058085d2

Mangle the request class mangling stuff. It's still fugly, but it's no longer totally retarded
---

diff --git a/Makefile.PL b/Makefile.PL
index dc2b9e5..98b9f2c 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,7 +5,9 @@ perl_version '5.8.1';
 name 'Catalyst-Action-REST';
 all_from 'lib/Catalyst/Action/REST.pm';
 
-requires('Catalyst::Runtime'         => '5.7001');
+requires 'Moose';
+requires 'namespace::autoclean';
+requires('Catalyst::Runtime'         => '5.80');
 requires('Params::Validate'          => '0.76');
 requires('YAML::Syck'                => '0.67');
 requires('Module::Pluggable::Object' => undef);
@@ -15,8 +17,8 @@ requires('Class::Inspector'          => '1.13');
 requires('URI::Find'                 => undef);
 requires('MRO::Compat'               => '0.10');
 
-requires 'Moose';
 requires 'namespace::autoclean';
+test_requires 'Test::More' => '0.88';
 
 feature 'JSON (application/json) support',
     -default   => 0,
diff --git a/lib/Catalyst/Request/REST.pm b/lib/Catalyst/Request/REST.pm
index b9b921b..ba60659 100644
--- a/lib/Catalyst/Request/REST.pm
+++ b/lib/Catalyst/Request/REST.pm
@@ -16,11 +16,19 @@ sub _insert_self_into {
 
   my $req_class = $app->request_class;
   return if $req_class->isa($class);
+  my $req_class_meta = Moose->init_meta( for_class => $req_class );
+  return if $req_class_meta->does_role('Catalyst::TraitFor::Request::REST');
   if ($req_class eq 'Catalyst::Request') {
     $app->request_class($class);
-  } else {
-    die "$app has a custom request class $req_class, "
-      . "which is not a $class; see Catalyst::Request::REST";
+  }
+  else {
+      my $meta = Moose::Meta::Class->create_anon_class(
+          superclasses => [$req_class],
+          roles => ['Catalyst::TraitFor::Request::REST'],
+          cache => 1
+      );
+      $meta->add_method(meta => sub { $meta });
+      $app->request_class($meta->name);
   }
 }
 
diff --git a/t/catalyst-request-rest.t b/t/catalyst-request-rest.t
index 2226793..ebb7b7d 100644
--- a/t/catalyst-request-rest.t
+++ b/t/catalyst-request-rest.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 28;
+use Test::More;
 use FindBin;
 use lib ( "$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib" );
 
@@ -175,9 +175,18 @@ use HTTP::Headers;
   is($test->request_class, 'Catalyst::Request::REST',
     'Request::REST took over for Request');
 
-  $test->request_class('Some::Other::Class');
+  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 };
-  like $@, qr/$test has a custom request class Some::Other::Class/;
+  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;
@@ -188,6 +197,8 @@ use HTTP::Headers;
   is $@, '', 'no error from Request::REST subclass';
 }
 
+done_testing;
+
 package MockContext;
 
 sub prepare_body { }