From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 9 Aug 2011 01:50:52 +0000 (+0000)
Subject: factor out hook application code
X-Git-Tag: v1.001000~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=91e80be918f88928336d8c6ef72c1d24b48adb87;p=p5sagit%2FClass-C3-Componentised.git

factor out hook application code
---

diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm
index a5c3b99..13e1ffe 100644
--- a/lib/Class/C3/Componentised.pm
+++ b/lib/Class/C3/Componentised.pm
@@ -48,6 +48,7 @@ use warnings;
 use MRO::Compat;
 
 use Carp ();
+use List::Util ();
 
 our $VERSION = 1.0009;
 
@@ -191,34 +192,18 @@ sub inject_base {
   mro::set_mro($target, 'c3');
 
   for my $comp (reverse @_) {
-    no strict 'refs';
+    my $apply = do {
+      no strict 'refs';
+      sub { unshift ( @{"${target}::ISA"}, $comp ) };
+    };
     unless ($target eq $comp || $target->isa($comp)) {
-      my @heritage = @{mro::get_linear_isa($comp)};
-
-      my @before = map {
-         my $to_run = $Class::C3::Componentised::ApplyHooks::Before{$_};
-         ($to_run?[$_,$to_run]:())
-      } @heritage;
-
-      for my $todo (@before) {
-         my ($parent, $fn)  = @$todo;
-         for my $f (reverse @$fn) {
-            $target->$f($parent)
-         }
-      }
-
-      unshift ( @{"${target}::ISA"}, $comp );
-
-      my @after = map {
-         my $to_run = $Class::C3::Componentised::ApplyHooks::After{$_};
-         ($to_run?[$_,$to_run]:())
-      } @heritage;
-
-      for my $todo (reverse @after) {
-         my ($parent, $fn)  = @$todo;
-         for my $f (@$fn) {
-            $target->$f($parent)
-         }
+      our %APPLICATOR_FOR;
+      if (my $apply_class
+            = List::Util::first { $APPLICATOR_FOR{$_} } @{mro::get_linear_isa($comp)}
+      ) {
+        $APPLICATOR_FOR{$apply_class}->_apply_component_to_class($comp,$target,$apply);
+      } else {
+        $apply->();
       }
     }
   }
diff --git a/lib/Class/C3/Componentised/ApplyHooks.pm b/lib/Class/C3/Componentised/ApplyHooks.pm
index 6eb8bec..49d9948 100644
--- a/lib/Class/C3/Componentised/ApplyHooks.pm
+++ b/lib/Class/C3/Componentised/ApplyHooks.pm
@@ -6,8 +6,45 @@ use warnings;
 our %Before;
 our %After;
 
-sub BEFORE_APPLY (&) { push @{$Before{scalar caller}}, $_[0] };
-sub AFTER_APPLY  (&) { push @{$After {scalar caller}}, $_[0] };
+sub BEFORE_APPLY (&) {
+  push @{$Before{scalar caller}}, $_[0];
+  $Class::C3::Componentised::APPLICATOR_FOR{scalar caller} = __PACKAGE__;
+}
+sub AFTER_APPLY  (&) {
+  push @{$After {scalar caller}}, $_[0];
+  $Class::C3::Componentised::APPLICATOR_FOR{scalar caller} = __PACKAGE__;
+}
+
+sub _apply_component_to_class {
+  my ($me, $comp, $target, $apply) = @_;
+  my @heritage = @{mro::get_linear_isa($comp)};
+
+  my @before = map {
+     my $to_run = $Before{$_};
+     ($to_run?[$_,$to_run]:())
+  } @heritage;
+
+  for my $todo (@before) {
+     my ($parent, $fn)  = @$todo;
+     for my $f (reverse @$fn) {
+        $target->$f($parent)
+     }
+  }
+
+  $apply->();
+
+  my @after = map {
+     my $to_run = $After{$_};
+     ($to_run?[$_,$to_run]:())
+  } @heritage;
+
+  for my $todo (reverse @after) {
+     my ($parent, $fn)  = @$todo;
+     for my $f (@$fn) {
+        $target->$f($parent)
+     }
+  }
+} 
 
 {
    no strict 'refs';
@@ -29,11 +66,13 @@ sub AFTER_APPLY  (&) { push @{$After {scalar caller}}, $_[0] };
          if ($arg eq '-before_apply') {
             $default = 0;
             $skip = 1;
-            push @{$Before{$to}}, $args[$i + 1]
+            push @{$Before{$to}}, $args[$i + 1];
+            $Class::C3::Componentised::APPLICATOR_FOR{$to} = $from;
          } elsif ($arg eq '-after_apply') {
             $default = 0;
             $skip = 1;
             push @{$After{$to}}, $args[$i + 1];
+            $Class::C3::Componentised::APPLICATOR_FOR{$to} = $from;
          } elsif ($arg =~ /^BEFORE_APPLY|AFTER_APPLY$/) {
             $default = 0;
             push @import, $arg