bump version to 0.75

[gitmo/Class-MOP.git] / lib / Class / MOP.pm

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index e173d1c..1efe34e 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -31,7 +31,7 @@ BEGIN {
     *check_package_cache_flag = \&mro::get_pkg_gen;
 }
 
-our $VERSION   = '0.66';
+our $VERSION   = '0.75';
 our $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';    
@@ -100,22 +100,62 @@ sub _load_pure_perl {
     # because I don't yet see a good reason to do so.
 }
 
-sub load_class {
-    my $class = shift;
+sub load_first_existing_class {
+    my @classes = @_
+        or return;
 
-    unless ( _is_valid_class_name($class) ) {
-        my $display = defined($class) ? $class : 'undef';
-        confess "Invalid class name ($display)";
+    foreach my $class (@classes) {
+        unless ( _is_valid_class_name($class) ) {
+            my $display = defined($class) ? $class : 'undef';
+            confess "Invalid class name ($display)";
+        }
     }
 
-    # if the class is not already loaded in the symbol table..
-    unless (is_class_loaded($class)) {
-        # require it
-        my $e = do { local $@; eval "require $class"; $@ };
-        confess "Could not load class ($class) because : $e" if $e;
+    my $found;
+    my %exceptions;
+    for my $class (@classes) {
+        my $e = _try_load_one_class($class);
+
+        if ($e) {
+            $exceptions{$class} = $e;
+        }
+        else {
+            $found = $class;
+            last;
+        }
     }
 
-    get_metaclass_by_name($class) || $class if defined wantarray;
+    return $found if $found;
+
+    confess join(
+        "\n",
+        map {
+            sprintf(
+                "Could not load class (%s) because : %s", $_,
+                $exceptions{$_}
+                )
+            } @classes
+    );
+}
+
+sub _try_load_one_class {
+    my $class = shift;
+
+    return if is_class_loaded($class);
+
+    my $file = $class . '.pm';
+    $file =~ s{::}{/}g;
+
+    return do {
+        local $@;
+        eval { require($file) };
+        $@;
+    };
+}
+
+sub load_class {
+    my $class = load_first_existing_class($_[0]);
+    return get_metaclass_by_name($class) || $class;
 }
 
 sub _is_valid_class_name {
@@ -133,7 +173,7 @@ sub _is_valid_class_name {
 sub is_class_loaded {
     my $class = shift;
 
-    return 0 if ref($class) || !defined($class) || !length($class);
+    return 0 unless _is_valid_class_name($class);
 
     # walk the symbol table tree to avoid autovififying
     # \*{${main::}{"Foo::"}} == \*main::Foo::
@@ -488,9 +528,18 @@ Class::MOP::Method->meta->add_attribute(
     ))
 );
 
+Class::MOP::Method->meta->add_attribute(
+    Class::MOP::Attribute->new('original_method' => (
+        reader   => { 'original_method'      => \&Class::MOP::Method::original_method },
+        writer   => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
+    ))
+);
+
 Class::MOP::Method->meta->add_method('clone' => sub {
     my $self  = shift;
-    $self->meta->clone_object($self, @_);
+    my $clone = $self->meta->clone_object($self, @_);
+    $clone->_set_original_method($self);
+    return $clone;
 });
 
 ## --------------------------------------------------------
@@ -604,12 +653,8 @@ undef Class::MOP::Instance->meta->{_package_cache_flag};
 ## --------------------------------------------------------
 ## Now close all the Class::MOP::* classes
 
-# NOTE:
-# we don't need to inline the
-# constructors or the accessors
-# this only lengthens the compile
-# time of the MOP, and gives us
-# no actual benefits.
+# NOTE: we don't need to inline the the accessors this only lengthens
+# the compile time of the MOP, and gives us no actual benefits.
 
 $_->meta->make_immutable(
     inline_constructor  => 1,
@@ -894,6 +939,16 @@ destruction.
 
 Otherwise it's a constant returning false.
 
+=item B<load_first_existing_class ($class_name, [$class_name, ...])>
+
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
+Given a list of class names, this function will attempt to load each
+one in turn.
+
+If it finds a class it can load, it will return that class' name.
+If none of the classes can be loaded, it will throw an exception.
+
 =back
 
 =head2 Metaclass cache functions
@@ -1049,6 +1104,8 @@ B<with contributions from:>
 
 Brandon (blblack) Black
 
+Florian (rafl) Ragwitz
+
 Guillermo (groditi) Roditi
 
 Matt (mst) Trout