X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=e8d3e638f943f1925f938c465260bea330a17d18;hb=a9a053ab55144bfedc80b8e7e39712a747837cae;hp=54ee7f49305fbe378cf7125d9380410cdabb677c;hpb=53e908736ce4525f484da15637d259695353d604;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 54ee7f4..e8d3e63 100644 --- 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.81'; 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 - -Whether or not the L pragma provides C, 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. This will load the specified C<$class_name>. This function can be used in place of tricks like C or using C -unconditionally. +unconditionally. This will return the metaclass of C<$class_name>. =item B @@ -887,6 +894,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 + +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 will be returned. + =item B B