X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=cf8048991c0d5ae834c41197078cc6294cd3c8a1;hb=7fe2c0b65ce511286856916fc8f245d2d3bc4f9c;hp=bad6771deccf154f7d5a708571d1311f9a96de17;hpb=53702399aa78de5155c629c5698035cbe44707c1;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index bad6771..cf80489 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -9,9 +9,7 @@ use 5.008; use MRO::Compat; use Carp 'confess'; -use Devel::GlobalDestruction qw( in_global_destruction ); use Scalar::Util 'weaken', 'reftype', 'blessed'; -use Sub::Name qw( subname ); use Class::MOP::Class; use Class::MOP::Attribute; @@ -31,7 +29,7 @@ BEGIN { *check_package_cache_flag = \&mro::get_pkg_gen; } -our $VERSION = '0.82_02'; +our $VERSION = '0.89'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -45,10 +43,9 @@ XSLoader::load( __PACKAGE__, $XS_VERSION ); # there is no need to worry about destruction though # because they should die only when the program dies. # After all, do package definitions even get reaped? + # Anonymous classes manage their own destruction. my %METAS; - # means of accessing all the metaclasses that have - # been initialized thus far (for mugwumps obj browser) sub get_all_metaclasses { %METAS } sub get_all_metaclass_instances { values %METAS } sub get_all_metaclass_names { keys %METAS } @@ -56,7 +53,7 @@ XSLoader::load( __PACKAGE__, $XS_VERSION ); sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] } sub weaken_metaclass { weaken($METAS{$_[0]}) } sub does_metaclass_exist { exists $METAS{$_[0]} && defined $METAS{$_[0]} } - sub remove_metaclass_by_name { $METAS{$_[0]} = undef } + sub remove_metaclass_by_name { delete $METAS{$_[0]}; return } # This handles instances as well as class names sub class_of { @@ -95,10 +92,10 @@ 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) { + my $pmfile = _class_to_pmfile($class); $exceptions{$class} = $e; last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/; } @@ -133,6 +130,7 @@ sub _try_load_one_class { return do { local $@; + local $SIG{__DIE__}; eval { require($file) }; $@; }; @@ -155,6 +153,18 @@ sub _is_valid_class_name { return 0; } +sub subname { + require Sub::Name; + Carp::carp("Class::MOP::subname is deprecated. Please use Sub::Name directly."); + goto \&Sub::Name::subname; +} + +sub in_global_destruction { + require Devel::GlobalDestruction; + Carp::carp("Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly."); + goto \&Devel::GlobalDestruction::in_global_destruction; +} + ## ---------------------------------------------------------------------------- ## Setting up our environment ... ## ---------------------------------------------------------------------------- @@ -497,6 +507,14 @@ Class::MOP::Attribute->meta->add_attribute( )) ); +Class::MOP::Attribute->meta->add_attribute( + Class::MOP::Attribute->new('insertion_order' => ( + reader => { 'insertion_order' => \&Class::MOP::Attribute::insertion_order }, + writer => { '_set_insertion_order' => \&Class::MOP::Attribute::_set_insertion_order }, + predicate => { 'has_insertion_order' => \&Class::MOP::Attribute::has_insertion_order }, + )) +); + Class::MOP::Attribute->meta->add_method('clone' => sub { my $self = shift; $self->meta->clone_object($self, @_); @@ -672,21 +690,14 @@ 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, + inline_constructor => 0, constructor_name => "_new", inline_accessors => 0, ) for qw/ 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 @@ -913,9 +924,11 @@ Note that these are all called as B. =item B -This will load the specified C<$class_name>. This function can be used +This will load the specified C<$class_name>, if it is not already +loaded (as reported by C). This function can be used in place of tricks like C or using C -unconditionally. This will return the metaclass of C<$class_name>. +unconditionally. This will return the metaclass of C<$class_name> if +one exists, otherwise it will return C<$class_name>. =item B @@ -925,7 +938,9 @@ loaded. This does a basic check of the symbol table to try and determine as best it can if the C<$class_name> is loaded, it is probably correct about 99% of the time, but it can be fooled into reporting false -positives. +positives. In particular, loading any of the core L modules will +cause most of the rest of the core L modules to falsely report +having been loaded, due to the way the base L module works. =item B @@ -936,9 +951,9 @@ 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. +This will return the metaclass of the given instance or class name. If the +class lacks a metaclass, no metaclass will be initialized, and C will be +returned. =item B @@ -1137,6 +1152,8 @@ Yuval (nothingmuch) Kogman Scott (konobi) McWhirter +Dylan Hardison + =head1 COPYRIGHT AND LICENSE Copyright 2006-2009 by Infinity Interactive, Inc.