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::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.78';
+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 );
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
# 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;
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;
"Could not load class (%s) because : %s", $_,
$exceptions{$_}
)
+ }
+ grep {
+ exists $exceptions{$_}
} @classes
);
}
return if is_class_loaded($class);
- my $file = $class . '.pm';
- $file =~ s{::}{/}g;
+ my $file = _class_to_pmfile($class);
return do {
local $@;
# 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
))
);
+Class::MOP::Class->meta->add_attribute(
+ Class::MOP::Attribute->new('immutable_transformer' => (
+ reader => {
+ 'immutable_transformer' => \&Class::MOP::Class::immutable_transformer
+ },
+ writer => {
+ '_set_immutable_transformer' => \&Class::MOP::Class::_set_immutable_transformer
+ },
+ ))
+);
+
# NOTE:
# 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
Class::MOP - A Meta Object Protocol for Perl 5
-=head1 DESCRIPTON
+=head1 DESCRIPTION
This module is a fully functioning meta object protocol for the
Perl 5 object system. It makes no attempt to change the behavior or
handles the introspection/reflection features of the object system.
All object systems have implicit MOPs. Without one, they would not
-work. Explict MOPs are much less common, and depending on the language
-can vary from restrictive (Reflection in Java or C#) to wide open
-(CLOS is a perfect example).
+work. Explicit MOPs are much less common, and depending on the
+language can vary from restrictive (Reflection in Java or C#) to wide
+open (CLOS is a perfect example).
=head2 Yet Another Class Builder! Why?
=head2 What changes do I have to make to use this module?
This module was designed to be as unintrusive as possible. Many of its
-features are accessible without B<any> change to your existsing
+features are accessible without B<any> change to your existing
code. It is meant to be a compliment to your existing code and not an
intrusion on your code base. Unlike many other B<Class::> modules,
this module B<does not> require you subclass it, or even that you
=head2 About Performance
-It is a common misconception that explict MOPs are a performance hit.
+It is a common misconception that explicit MOPs are a performance hit.
This is not a universal truth, it is a side-effect of some specific
implementations. For instance, using Java reflection is slow because
the JVM cannot take advantage of any compiler optimizations, and the
=head2 Using custom metaclasses
Always use the L<metaclass> pragma when using a custom metaclass, this
-will ensure the proper initialization order and not accidentely create
-an incorrect type of metaclass for you. This is a very rare problem,
-and one which can only occur if you are doing deep metaclass
+will ensure the proper initialization order and not accidentally
+create an incorrect type of metaclass for you. This is a very rare
+problem, and one which can only occur if you are doing deep metaclass
programming. So in other words, don't worry about it.
Note that if you're using L<Moose> we encourage you to I<not> use
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
-compat.
-
-=item I<Class::MOP::HAVE_ISAREV>
-
-Whether or not the L<mro> pragme provides C<get_isarev>, a much faster
-way to get all the subclasses of a certain class.
+compatible.
=back
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)>
about 99% of the time, but it can be fooled into reporting false
positives.
+=item B<Class::MOP::get_code_info($code)>
+
+This function returns two values, the name of the package the C<$code>
+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!>
versions prior to 5.10, this will use the C<PL_sub_generation>
variable which is not package specific.
-=item B<Class::MOP::get_code_info($code)>
-
-B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
-
-This function returns two values, the name of the package the C<$code>
-is from and the name of the C<$code> itself. This is used by several
-elements of the MOP to detemine where a given C<$code> reference is
-from.
-
=item B<Class::MOP::load_first_existing_class(@class_names)>
B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2008 by Infinity Interactive, Inc.
+Copyright 2006-2009 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Class-MOP.git / blobdiff