X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=0968f0f9e7f28a8ab92e8a5fa126c5b4f93423af;hb=a0e95742d64c3965acf708b3beae14de5bfff766;hp=399976c91afd22862ca3c98cda2043fa85d7f828;hpb=d7fe25089fe79be9d93445f25c55dfed82b11e7a;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 399976c..0968f0f 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -10,32 +10,31 @@ 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;
 use Class::MOP::Attribute;
 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.82_02';
 our $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';    
+our $AUTHORITY = 'cpan:STEVAN';
 
 require XSLoader;
 XSLoader::load( __PACKAGE__, $XS_VERSION );
@@ -59,6 +58,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 +72,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 +95,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 +117,9 @@ sub load_first_existing_class {
                 "Could not load class (%s) because : %s", $_,
                 $exceptions{$_}
                 )
+            }
+        grep {
+            exists $exceptions{$_}
             } @classes
     );
 }
@@ -109,8 +129,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 $@;
@@ -158,7 +177,7 @@ sub _is_valid_class_name {
 
 # 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
@@ -330,12 +349,37 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('immutable_transformer' => (
+    Class::MOP::Attribute->new('immutable_trait' => (
+        reader   => {
+            'immutable_trait' => \&Class::MOP::Class::immutable_trait
+        },
+        default => "Class::MOP::Class::Immutable::Trait",
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('constructor_name' => (
+        reader   => {
+            'constructor_name' => \&Class::MOP::Class::constructor_name,
+        },
+        default => "new",
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('constructor_class' => (
         reader   => {
-            'immutable_transformer' => \&Class::MOP::Class::immutable_transformer
+            'constructor_class' => \&Class::MOP::Class::constructor_class,
         },
-        writer   => {
-            '_set_immutable_transformer' => \&Class::MOP::Class::_set_immutable_transformer
+        default => "Class::MOP::Method::Constructor",
+    ))
+);
+
+
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('destructor_class' => (
+        reader   => {
+            'destructor_class' => \&Class::MOP::Class::destructor_class,
         },
     ))
 );
@@ -344,7 +388,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
@@ -526,6 +570,16 @@ Class::MOP::Method::Generated->meta->add_attribute(
     ))
 );
 
+
+## --------------------------------------------------------
+## Class::MOP::Method::Inlined
+
+Class::MOP::Method::Inlined->meta->add_attribute(
+    Class::MOP::Attribute->new('_expected_method_class' => (
+        reader   => { '_expected_method_class' => \&Class::MOP::Method::Inlined::_expected_method_class },
+    ))
+);
+
 ## --------------------------------------------------------
 ## Class::MOP::Method::Accessor
 
@@ -618,6 +672,10 @@ undef Class::MOP::Instance->meta->{_package_cache_flag};
 # 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.
 
+# this is just nitpicking to ensure Class::MOP::Class->meta == ->meta->meta
+Class::MOP::Class->meta->_immutable_metaclass;
+$Class::MOP::Class::immutable_metaclass_cache{"Class::MOP::Class"}{"Class::MOP::Class::Immutable::Trait"} = Class::MOP::Class::Immutable::Class::MOP::Class->meta;
+
 $_->meta->make_immutable(
     inline_constructor  => 1,
     replace_constructor => 1,
@@ -627,6 +685,8 @@ $_->meta->make_immutable(
     Class::MOP::Package
     Class::MOP::Module
     Class::MOP::Class
+    Class::MOP::Class::Immutable::Trait
+    Class::MOP::Class::Immutable::Class::MOP::Class
 
     Class::MOP::Attribute
     Class::MOP::Method
@@ -635,6 +695,7 @@ $_->meta->make_immutable(
     Class::MOP::Object
 
     Class::MOP::Method::Generated
+    Class::MOP::Method::Inlined
 
     Class::MOP::Method::Accessor
     Class::MOP::Method::Constructor
@@ -842,11 +903,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
@@ -859,7 +915,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)>
 
@@ -878,6 +934,12 @@ is from and the name of the C<$code> itself. This is used by several
 elements of the MOP to determine where a given C<$code> reference is
 from.
 
+=item B<Class::MOP::class_of($instance_or_class_name)>
+
+This will return the metaclass of the given instance or class name.
+Even if the class lacks a metaclass, no metaclass will be initialized
+and C<undef> will be returned.
+
 =item B<Class::MOP::check_package_cache_flag($pkg)>
 
 B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>