X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=5066d3d616873dd978defda58e755c2d0d62eeb4;hb=28fa06b5d932b8a2f9bc1b6b394893c0d7c9efac;hp=79608afe8675258affce95626069396d4d6808d3;hpb=34147f49f7fa85afe801d684c3e25322e4a34f61;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 79608af..5066d3d 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -9,7 +9,7 @@ use 5.008; use MRO::Compat; use Carp 'confess'; -use Scalar::Util 'weaken'; +use Scalar::Util 'weaken', 'reftype'; use Class::MOP::Class; @@ -31,13 +31,11 @@ BEGIN { *check_package_cache_flag = \&mro::get_pkg_gen; } -our $VERSION = '0.71_01'; +our $VERSION = '0.78'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; - -# after that everything is loaded, if we're allowed try to load faster XS -# versions of various things + _try_load_xs() or _load_pure_perl(); sub _try_load_xs { @@ -57,6 +55,8 @@ sub _try_load_xs { require Devel::GlobalDestruction; Devel::GlobalDestruction->import("in_global_destruction"); + + *USING_XS = sub () { 1 }; }; $@; }; @@ -71,7 +71,9 @@ sub _load_pure_perl { Sub::Identify->import('get_code_info'); *subname = sub { $_[1] }; - *in_global_destruction = sub () { !1 } + *in_global_destruction = sub () { !1 }; + + *USING_XS = sub () { 0 }; } @@ -184,9 +186,19 @@ sub is_class_loaded { $pack = \*{${$$pack}{"${part}::"}}; } - # check for $VERSION or @ISA - return 1 if exists ${$$pack}{VERSION} - && defined *{${$$pack}{VERSION}}{SCALAR}; + # We used to check in the package stash, but it turns out that + # *{${$$package}{VERSION}{SCALAR}} can end up pointing to a + # reference to undef. It looks + + my $version = do { + no strict 'refs'; + ${$class . '::VERSION'}; + }; + + return 1 if ! ref $version && defined $version; + # Sometimes $VERSION ends up as a reference to undef (weird) + return 1 if ref $version && reftype $version eq 'SCALAR' && defined ${$version}; + return 1 if exists ${$$pack}{ISA} && defined *{${$$pack}{ISA}}{ARRAY}; @@ -376,6 +388,18 @@ Class::MOP::Class->meta->add_attribute( ); Class::MOP::Class->meta->add_attribute( + Class::MOP::Attribute->new('wrapped_method_metaclass' => ( + reader => { + # NOTE: + # we just alias the original method + # rather than re-produce it here + 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass + }, + default => 'Class::MOP::Method::Wrapped', + )) +); + +Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('instance_metaclass' => ( reader => { # NOTE: we need to do this in order @@ -449,6 +473,12 @@ Class::MOP::Attribute->meta->add_attribute( ); Class::MOP::Attribute->meta->add_attribute( + Class::MOP::Attribute->new('definition_context' => ( + reader => { 'definition_context' => \&Class::MOP::Attribute::definition_context }, + )) +); + +Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->new('writer' => ( reader => { 'writer' => \&Class::MOP::Attribute::writer }, predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer }, @@ -564,6 +594,12 @@ Class::MOP::Method::Generated->meta->add_attribute( )) ); +Class::MOP::Method::Generated->meta->add_attribute( + Class::MOP::Attribute->new('definition_context' => ( + reader => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context }, + )) +); + ## -------------------------------------------------------- ## Class::MOP::Method::Accessor @@ -653,12 +689,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, @@ -883,6 +915,10 @@ compat. Whether or not C provides C, a much faster way to get all the subclasses of a certain class. +=item I + +Whether or not the running C is using its XS version. + =back =head2 Utility functions @@ -957,32 +993,32 @@ If none of the classes can be loaded, it will throw an exception. =head2 Metaclass cache functions -Class::MOP holds a cache of metaclasses, the following are functions +Class::MOP holds a cache of metaclasses. The following are functions (B) which can be used to access that cache. It is not -recommended that you mess with this, bad things could happen. But if -you are brave and willing to risk it, go for it. +recommended that you mess with these. Bad things could happen, but if +you are brave and willing to risk it: go for it! =over 4 =item B -This will return an hash of all the metaclass instances that have -been cached by B keyed by the package name. +This will return a hash of all the metaclass instances that have +been cached by B, keyed by the package name. =item B -This will return an array of all the metaclass instances that have +This will return a list of all the metaclass instances that have been cached by B. =item B -This will return an array of all the metaclass names that have +This will return a list of all the metaclass names that have been cached by B. =item B -This will return a cached B instance of nothing -if no metaclass exist by that C<$name>. +This will return a cached B instance, or nothing +if no metaclass exists with that C<$name>. =item B @@ -990,18 +1026,19 @@ This will store a metaclass in the cache at the supplied C<$key>. =item B -In rare cases it is desireable to store a weakened reference in -the metaclass cache. This function will weaken the reference to -the metaclass stored in C<$name>. +In rare cases (e.g. anonymous metaclasses) it is desirable to +store a weakened reference in the metaclass cache. This +function will weaken the reference to the metaclass stored +in C<$name>. =item B This will return true of there exists a metaclass stored in the -C<$name> key and return false otherwise. +C<$name> key, and return false otherwise. =item B -This will remove a the metaclass stored in the C<$name> key. +This will remove the metaclass stored in the C<$name> key. =back