Include stack traces in the deprecation warnings.

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

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index c288272..7f68060 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -10,7 +10,7 @@ use MRO::Compat;
 
 use Carp          'confess';
 use Devel::GlobalDestruction qw( in_global_destruction );
-use Scalar::Util  'weaken', 'reftype';
+use Scalar::Util  'weaken', 'reftype', 'blessed';
 use Sub::Name qw( subname );
 
 use Class::MOP::Class;
@@ -20,22 +20,23 @@ use Class::MOP::Method;
 use Class::MOP::Immutable;
 
 BEGIN {
-    *IS_RUNNING_ON_5_10 = ($] < 5.009_005) 
+    *IS_RUNNING_ON_5_10 = ($] < 5.009_005)
         ? sub () { 0 }
-        : sub () { 1 };    
-
-    *HAVE_ISAREV = defined(&mro::get_isarev)
-        ? sub () { 1 }
         : sub () { 1 };
 
+    sub HAVE_ISAREV () {
+        Carp::cluck("Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway.");
+        return 1;
+    }
+
     # this is either part of core or set up appropriately by MRO::Compat
     *check_package_cache_flag = \&mro::get_pkg_gen;
 }
 
-our $VERSION   = '0.79';
+our $VERSION   = '0.80_01';
 our $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';    
+our $AUTHORITY = 'cpan:STEVAN';
 
 require XSLoader;
 XSLoader::load( __PACKAGE__, $XS_VERSION );
@@ -59,6 +60,13 @@ XSLoader::load( __PACKAGE__, $XS_VERSION );
     sub does_metaclass_exist        { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
     sub remove_metaclass_by_name    { $METAS{$_[0]} = undef }
 
+    # This handles instances as well as class names
+    sub class_of {
+        return unless defined $_[0];
+        my $class = blessed($_[0]) || $_[0];
+        return $METAS{$class};
+    }
+
     # NOTE:
     # We only cache metaclasses, meaning instances of
     # Class::MOP::Class. We do not cache instance of
@@ -66,6 +74,15 @@ XSLoader::load( __PACKAGE__, $XS_VERSION );
     # because I don't yet see a good reason to do so.
 }
 
+sub _class_to_pmfile {
+    my $class = shift;
+
+    my $file = $class . '.pm';
+    $file =~ s{::}{/}g;
+
+    return $file;
+}
+
 sub load_first_existing_class {
     my @classes = @_
         or return;
@@ -80,10 +97,12 @@ sub load_first_existing_class {
     my $found;
     my %exceptions;
     for my $class (@classes) {
+        my $pmfile = _class_to_pmfile($class);
         my $e = _try_load_one_class($class);
 
         if ($e) {
             $exceptions{$class} = $e;
+            last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/;
         }
         else {
             $found = $class;
@@ -100,6 +119,9 @@ sub load_first_existing_class {
                 "Could not load class (%s) because : %s", $_,
                 $exceptions{$_}
                 )
+            }
+        grep {
+            exists $exceptions{$_}
             } @classes
     );
 }
@@ -109,8 +131,7 @@ sub _try_load_one_class {
 
     return if is_class_loaded($class);
 
-    my $file = $class . '.pm';
-    $file =~ s{::}{/}g;
+    my $file = _class_to_pmfile($class);
 
     return do {
         local $@;
@@ -136,15 +157,6 @@ sub _is_valid_class_name {
     return 0;
 }
 
-sub class_of {
-    my $self  = shift;
-    my $class = shift;
-
-    $class = blessed($class) || $class;
-
-    return get_metaclass_by_name($class);
-}
-
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...
 ## ----------------------------------------------------------------------------
@@ -167,7 +179,7 @@ sub class_of {
 
 # We need to add in the meta-attributes here so that
 # any subclass of Class::MOP::* will be able to
-# inherit them using &construct_instance
+# inherit them using _construct_instance
 
 ## --------------------------------------------------------
 ## Class::MOP::Package
@@ -353,7 +365,7 @@ Class::MOP::Class->meta->add_attribute(
 # we don't actually need to tie the knot with
 # Class::MOP::Class here, it is actually handled
 # within Class::MOP::Class itself in the
-# construct_class_instance method.
+# _construct_class_instance method.
 
 ## --------------------------------------------------------
 ## Class::MOP::Attribute
@@ -851,11 +863,6 @@ We set this constant depending on what version perl we are on, this
 allows us to take advantage of new 5.10 features and stay backwards
 compatible.
 
-=item I<Class::MOP::HAVE_ISAREV>
-
-Whether or not the L<mro> pragma provides C<get_isarev>, a much faster
-way to get all the subclasses of a certain class.
-
 =back
 
 =head2 Utility functions
@@ -868,7 +875,7 @@ Note that these are all called as B<functions, not methods>.
 
 This will load the specified C<$class_name>. This function can be used
 in place of tricks like C<eval "use $module"> or using C<require>
-unconditionally.
+unconditionally. This will return the metaclass of C<$class_name>.
 
 =item B<Class::MOP::is_class_loaded($class_name)>