X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FC3%2FComponentised.pm;h=5506a156be0837a0c536e6c86f4877bf2c09cc03;hb=b3683522ddff5d087f6008c45353861605da0c2e;hp=ea2bb8170646d9453044061c718368fd1e489462;hpb=ade50a21cd4aecf2976f12b455b47c7ae1e4ea30;p=p5sagit%2FClass-C3-Componentised.git

diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm
index ea2bb81..5506a15 100644
--- a/lib/Class/C3/Componentised.pm
+++ b/lib/Class/C3/Componentised.pm
@@ -40,13 +40,18 @@ L<MooseX::Object::Pluggable>.
 use strict;
 use warnings;
 
-# see Makefile.PL for discussion on why we load both Class::C3 and MRO::Compat
-use Class::C3 ();
+# This will prime the Class::C3 namespace (either by loading it proper on 5.8
+# or by installing compat shims on 5.10+). A user might have a reasonable
+# expectation that using Class::C3::<something> will give him access to
+# Class::C3 itself, and this module has been providing this historically.
+# Therefore leaving it in indefinitely.
 use MRO::Compat;
-use Class::Inspector;
+
 use Carp;
 
-our $VERSION = 1.0006;
+our $VERSION = 1.0007;
+
+my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x;
 
 =head2 load_components( @comps )
 
@@ -60,13 +65,12 @@ Calling this will call C<Class::C3::reinitialize>.
 
 sub load_components {
   my $class = shift;
-  my @comp = map {
-              /^\+(.*)$/
-                ? $1
-                : join ('::', $class->component_base_class, $_)
-             }
-             grep { $_ !~ /^#/ } @_;
-  $class->_load_components(@comp);
+  $class->_load_components( map {
+    /^\+(.*)$/
+      ? $1
+      : join ('::', $class->component_base_class, $_)
+    } grep { $_ !~ /^#/ } @_
+  );
 }
 
 =head2 load_own_components( @comps )
@@ -77,16 +81,15 @@ Similar to L<load_components>, but assumes every class is C<"$class::$comp">.
 
 sub load_own_components {
   my $class = shift;
-  my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
-  $class->_load_components(@comp);
+  $class->_load_components( map { "${class}::$_" } grep { $_ !~ /^#/ } @_ );
 }
 
 sub _load_components {
-  my ($class, @comp) = @_;
-  foreach my $comp (@comp) {
-    $class->ensure_class_loaded($comp);
-  }
-  $class->inject_base($class => @comp);
+  my $class = shift;
+  return unless @_;
+
+  $class->ensure_class_loaded($_) for @_;
+  $class->inject_base($class => @_);
   Class::C3::reinitialize();
 }
 
@@ -99,15 +102,16 @@ found.
 
 sub load_optional_components {
   my $class = shift;
-  my @comp = grep { $class->load_optional_class( $_ ) }
-             map {
-              /^\+(.*)$/
-                ? $1
-                : join ('::', $class->component_base_class, $_)
-             }
-             grep { $_ !~ /^#/ } @_;
-
-  $class->_load_components( @comp ) if scalar @comp;
+  $class->_load_components( grep
+    { $class->load_optional_class( $_ ) }
+    ( map
+      { /^\+(.*)$/
+          ? $1
+          : join ('::', $class->component_base_class, $_)
+      }
+      grep { $_ !~ /^#/ } @_
+    )
+  );
 }
 
 =head2 ensure_class_loaded
@@ -120,26 +124,38 @@ is thrown if the class is still not loaded.
       require
 =cut
 
-#
-# TODO: handle ->has_many('rel', 'Class'...) instead of
-#              ->has_many('rel', 'Some::Schema::Class'...)
-#
 sub ensure_class_loaded {
   my ($class, $f_class) = @_;
 
-  croak "Invalid class name $f_class"
-      if ($f_class=~m/(?:\b:\b|\:{3,})/);
-  return if Class::Inspector->loaded($f_class);
-  my $file = $f_class . '.pm';
-  $file =~ s{::}{/}g;
-  eval { CORE::require($file) }; # require needs a bareword or filename
-  if ($@) {
+  no strict 'refs';
+
+  # ripped from Class::Inspector for speed
+  # note that the order is important (faster items are first)
+  return if ${"${f_class}::VERSION"};
+
+  return if @{"${f_class}::ISA"};
+
+  my $file = (join ('/', split ('::', $f_class) ) ) . '.pm';
+  return if $INC{$file};
+
+  for ( keys %{"${f_class}::"} ) {
+    return if ( *{"${f_class}::$_"}{CODE} );
+  }
+
+
+  # require always returns true on success
+  eval { require($file) } or do {
+
+    $@ = "Invalid class name '$f_class'" if $f_class =~ $invalid_class;
+
     if ($class->can('throw_exception')) {
       $class->throw_exception($@);
     } else {
       croak $@;
     }
-  }
+  };
+
+  return;
 }
 
 =head2 ensure_class_found
@@ -155,9 +171,10 @@ avoided in modules that are likely to be included within a PAR.
 =cut
 
 sub ensure_class_found {
-  my ($class, $f_class) = @_;
-  return Class::Inspector->loaded($f_class) ||
-         Class::Inspector->installed($f_class);
+  #my ($class, $f_class) = @_;
+  require Class::Inspector;
+  return Class::Inspector->loaded($_[1]) ||
+         Class::Inspector->installed($_[1]);
 }
 
 
@@ -168,12 +185,15 @@ Does the actual magic of adjusting @ISA on the target module.
 =cut
 
 sub inject_base {
-  my ($class, $target, @to_inject) = @_;
-  {
+  my $class = shift;
+  my $target = shift;
+
+  my %isa = map { $_ => 1 } ($target, @{mro::get_linear_isa($target)} );
+
+  for (reverse @_) {
     no strict 'refs';
-    foreach my $to (reverse @to_inject) {
-      unshift ( @{"${target}::ISA"}, $to )
-        unless ($target eq $to || $target->isa($to));
+    unless ($isa{$_}++) {
+      unshift ( @{"${target}::ISA"}, $_ );
     }
   }
 
@@ -190,19 +210,28 @@ successfully, and false if the class is not installed
 
 sub load_optional_class {
   my ($class, $f_class) = @_;
-  eval { $class->ensure_class_loaded($f_class) };
+
+  # ensure_class_loaded either returns a () (*not* true)  or throws
+  eval {
+   $class->ensure_class_loaded($f_class);
+   1;
+  } && return 1;
+
   my $err = $@;   # so we don't lose it
-  if (! $err) {
-    return 1;
+
+  if ($f_class =~ $invalid_class) {
+    $err = "Invalid class name '$f_class'";
   }
   else {
-    my $fn = (join ('/', split ('::', $f_class) ) ) . '.pm';
-    if ($err =~ /Can't locate ${fn} in \@INC/ ) {
-      return 0;
-    }
-    else {
-      die $err;
-    }
+    my $fn = quotemeta( (join ('/', split ('::', $f_class) ) ) . '.pm' );
+    return 0 if ($err =~ /Can't locate ${fn} in \@INC/ );
+  }
+
+  if ($class->can('throw_exception')) {
+    $class->throw_exception($err);
+  }
+  else {
+    die $err;
   }
 }