Add Class::C3::Componetised::ApplyHooks features

[p5sagit/Class-C3-Componentised.git] / lib / Class / C3 / Componentised.pm

diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm
index 5a33b39..a5c3b99 100644 (file)
--- a/lib/Class/C3/Componentised.pm
+++ b/lib/Class/C3/Componentised.pm
@@ -47,9 +47,11 @@ use warnings;
 # Therefore leaving it in indefinitely.
 use MRO::Compat;
 
-use Carp;
+use Carp ();
 
-our $VERSION = 1.0006;
+our $VERSION = 1.0009;
+
+my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x;
 
 =head2 load_components( @comps )
 
@@ -140,17 +142,16 @@ sub ensure_class_loaded {
     return if ( *{"${f_class}::$_"}{CODE} );
   }
 
-
   # require always returns true on success
-  eval { require($file) } or do {
+  # ill-behaved modules might very well obliterate $_
+  eval { local $_; require($file) } or do {
 
-    $@ = "Invalid class name $f_class"
-      if ($f_class=~m/(?:\b:\b|\:{3,})/);
+    $@ = "Invalid class name '$f_class'" if $f_class =~ $invalid_class;
 
     if ($class->can('throw_exception')) {
       $class->throw_exception($@);
     } else {
-      croak $@;
+      Carp::croak $@;
     }
   };
 
@@ -187,16 +188,40 @@ sub inject_base {
   my $class = shift;
   my $target = shift;
 
-  my %isa = map { $_ => 1 } ($target, @{mro::get_linear_isa($target)} );
+  mro::set_mro($target, 'c3');
 
-  for (reverse @_) {
+  for my $comp (reverse @_) {
     no strict 'refs';
-    unless ($isa{$_}++) {
-      unshift ( @{"${target}::ISA"}, $_ );
+    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)
+         }
+      }
     }
   }
-
-  mro::set_mro($target, 'c3');
 }
 
 =head2 load_optional_class
@@ -218,11 +243,15 @@ sub load_optional_class {
 
   my $err = $@;   # so we don't lose it
 
-  my $fn = quotemeta( (join ('/', split ('::', $f_class) ) ) . '.pm' );
-  if ($err =~ /Can't locate ${fn} in \@INC/ ) {
-    return 0;
+  if ($f_class =~ $invalid_class) {
+    $err = "Invalid class name '$f_class'";
+  }
+  else {
+    my $fn = quotemeta( (join ('/', split ('::', $f_class) ) ) . '.pm' );
+    return 0 if ($err =~ /Can't locate ${fn} in \@INC/ );
   }
-  elsif ($class->can('throw_exception')) {
+
+  if ($class->can('throw_exception')) {
     $class->throw_exception($err);
   }
   else {
@@ -230,12 +259,20 @@ sub load_optional_class {
   }
 }
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-Matt S. Trout and the DBIx::Class team
+Matt S. Trout and the L<DBIx::Class team|DBIx::Class/CONTRIBUTORS>
 
 Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >>
 
+Optimizations and overall bolt-tightening by Peter "ribasushi" Rabbitson
+C<< <ribasushi@cpan.org> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 - 2011 the Class::C3::Componentised L</AUTHORS> as listed
+above.
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.