[Catalyst-commits] r9692 - in CatalystX-Imports/branches/register_actions: . lib/CatalystX

[rafl at dev.catalyst.perl.org]

Author: rafl
Date: 2009-04-13 16:00:32 +0100 (Mon, 13 Apr 2009)
New Revision: 9692

Modified:
   CatalystX-Imports/branches/register_actions/Makefile.PL
   CatalystX-Imports/branches/register_actions/lib/CatalystX/Imports.pm
Log:
Port to use the mop to install action wrappers.

This requires current 5.80/trunk, which broke what we did before.

Modified: CatalystX-Imports/branches/register_actions/Makefile.PL
===================================================================
--- CatalystX-Imports/branches/register_actions/Makefile.PL	2009-04-13 14:57:04 UTC (rev 9691)
+++ CatalystX-Imports/branches/register_actions/Makefile.PL	2009-04-13 15:00:32 UTC (rev 9692)
@@ -12,7 +12,6 @@
 requires        q{Carp::Clan},                  0;
 requires        q{Filter::EOF},                 '0.02';
 requires        q{Class::MOP},                  0;
-requires        q{Class::Inspector},            0;
 requires        q{List::MoreUtils},             '0.19';
 requires        q{Scalar::Util},                '1.19';
 requires        q{Catalyst::Runtime},           '5.7000';

Modified: CatalystX-Imports/branches/register_actions/lib/CatalystX/Imports.pm
===================================================================
--- CatalystX-Imports/branches/register_actions/lib/CatalystX/Imports.pm	2009-04-13 14:57:04 UTC (rev 9691)
+++ CatalystX-Imports/branches/register_actions/lib/CatalystX/Imports.pm	2009-04-13 15:00:32 UTC (rev 9692)
@@ -188,24 +188,16 @@
 sub install_action_wrap_into {
     my ($class, $target) = @_;
 
-    # get all action cache entries
-    my @actions = @{ $target->_action_cache };
+    # get all action methods of the target class (not inherited actions)
+    my $meta = Class::MOP::class_of($target);
+    my @actions = $meta->get_method_with_attributes_list;
 
-    # lookup map with all the names of the methods
-    my %methods
-      = map { ($target->can($_) => $_) }
-           @{ Class::Inspector->functions($target) || [] };
-
     # replace every action code with a wrapper
     for my $action (@actions) {
-        my $original = $action->[0];
-
-        # only methods in that package are wanted
-        next unless exists $methods{ $original };
-
         # the wrapper fetches controller, context and args and stores
         # them for other parts of the CX:I module
-        my $wrapped = sub {
+        $meta->add_around_method_modifier($action->name => sub {
+            my $next = shift;
             my ($self, $c, @args) = @_;
 
             # fetch registered action call wrappers
@@ -230,33 +222,17 @@
 
             # call original code with original arguments
             unless (@wrappers) {
-                return $original->(@_);
+                return $next->(@_);
             }
 
             # delegate to wrapper
             else {
                 my $wrapper = shift @wrappers;
-                return $wrapper->($original, [@wrappers], @_);
+                return $wrapper->($next, [@wrappers], @_);
             }
-        };
-
-        # set the new code
-        $action->[0] = $wrapped;
-
-        # replace name in attribute cache
-        my $attrs = delete $target->_attr_cache->{ $original };
-        $target->_attr_cache->{ $wrapped } = $attrs;
-
-        # replace code reference in package
-        {   no strict 'refs';
-            no warnings 'redefine';
-            my $method_name = "${target}::$methods{$original}";
-            *$method_name = subname $method_name, $wrapped;
-        }
+        });
     }
 
-    $target->_action_cache( \@actions );
-
     return 1;
 }