X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=8426d14245dcce5fc1c91d0c96908dec6576d646;hb=f014c28ba9a61d3ff1eceb38e18acb266e803ad4;hp=2dbd9f2e3863ed849b6287ef3e572bd5af36f6c8;hpb=78902d1df967dfe480294acbeb65e2e2bae4439e;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 2dbd9f2..8426d14 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -17,7 +17,7 @@ use Devel::GlobalDestruction 'in_global_destruction'; use Try::Tiny; use List::MoreUtils 'all'; -our $VERSION = '1.09'; +our $VERSION = '1.10'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -53,9 +53,13 @@ sub reinitialize { my $old_metaclass = blessed($options{package}) ? $options{package} : Class::MOP::get_metaclass_by_name($options{package}); + $options{weaken} = Class::MOP::metaclass_is_weak($old_metaclass->name) + if !exists $options{weaken} + && blessed($old_metaclass) + && $old_metaclass->isa('Class::MOP::Class'); $old_metaclass->_remove_generated_metaobjects if $old_metaclass && $old_metaclass->isa('Class::MOP::Class'); - my $new_metaclass = $class->SUPER::reinitialize(@args); + my $new_metaclass = $class->SUPER::reinitialize(%options); $new_metaclass->_restore_metaobjects_from($old_metaclass) if $old_metaclass && $old_metaclass->isa('Class::MOP::Class'); return $new_metaclass; @@ -109,7 +113,7 @@ sub _construct_class_instance { # NOTE: # we need to weaken any anon classes # so that they can call DESTROY properly - Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class; + Class::MOP::weaken_metaclass($package_name) if $options->{weaken}; $meta; } @@ -444,6 +448,7 @@ sub _remove_generated_metaobjects { sub create_anon_class { my ($class, %options) = @_; + $options{weaken} = 1 unless exists $options{weaken}; my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL; return $class->create($package_name, %options); } @@ -504,13 +509,16 @@ sub create { || confess "You must pass a HASH ref of methods" if exists $options{methods}; + $options{meta_name} = 'meta' + unless exists $options{meta_name}; + my (%initialize_options) = @args; delete @initialize_options{qw( package superclasses attributes methods - no_meta + meta_name version authority )}; @@ -518,18 +526,8 @@ sub create { $meta->_instantiate_module( $options{version}, $options{authority} ); - # FIXME totally lame - $meta->add_method('meta' => sub { - if (Class::MOP::DEBUG_NO_META()) { - my ($self) = @_; - if (my $meta = try { $self->SUPER::meta }) { - return $meta if $meta->isa('Class::MOP::Class'); - } - confess "'meta' method called by MOP internals" - if caller =~ /Class::MOP|metaclass/; - } - $class->initialize(ref($_[0]) || $_[0]); - }) unless $options{no_meta}; + $meta->_add_meta_method($options{meta_name}) + if defined $options{meta_name}; $meta->superclasses(@{$options{superclasses}}) if exists $options{superclasses}; @@ -606,7 +604,7 @@ sub _construct_instance { } # NOTE: # this will only work for a HASH instance type - if ($class->is_anon_class) { + if (Class::MOP::metaclass_is_weak($class->name)) { (reftype($instance) eq 'HASH') || confess "Currently only HASH based instances are supported with instance of anon-classes"; # NOTE: @@ -688,6 +686,10 @@ sub _force_rebless_instance { $old_metaclass->rebless_instance_away($instance, $self, %params) if $old_metaclass; + if (Class::MOP::metaclass_is_weak($old_metaclass->name)) { + delete $instance->{__MOP__}; + } + my $meta_instance = $self->get_meta_instance; # rebless! @@ -695,6 +697,19 @@ sub _force_rebless_instance { $meta_instance->rebless_instance_structure($_[1], $self); $self->_fixup_attributes_after_rebless($instance, $old_metaclass, %params); + + # NOTE: + # this will only work for a HASH instance type + if (Class::MOP::metaclass_is_weak($self->name)) { + (reftype($instance) eq 'HASH') + || confess "Currently only HASH based instances are supported with instance of anon-classes"; + # NOTE: + # At some point we should make this official + # as a reserved slot name, but right now I am + # going to keep it here. + # my $RESERVED_MOP_SLOT = '__MOP__'; + $instance->{'__MOP__'} = $self; + } } sub rebless_instance { @@ -849,6 +864,16 @@ sub superclasses { sub _superclasses_updated { my $self = shift; $self->update_meta_instance_dependencies(); + # keep strong references to all our parents, so they don't disappear if + # they are anon classes and don't have any direct instances + $self->_superclass_metas( + map { Class::MOP::class_of($_) } $self->superclasses + ); +} + +sub _superclass_metas { + my $self = shift; + $self->{_superclass_metas} = [@_]; } sub subclasses { @@ -1447,9 +1472,26 @@ hash reference are method names and values are subroutine references. An optional array reference of L objects. -=item * no_meta +=item * meta_name + +Specifies the name to install the C method for this class under. +If it is not passed, C is assumed, and if C is explicitly +given, no meta method will be installed. + +=item * weaken -If true, a C method will not be installed into the class. +If true, the metaclass that is stored in the global cache will be a +weak reference. + +Classes created in this way are destroyed once the metaclass they are +attached to goes out of scope, and will be removed from Perl's internal +symbol table. + +All instances of a class with a weakened metaclass keep a special +reference to the metaclass object, which prevents the metaclass from +going out of scope while any instances exist. + +This only works if the instance is based on a hash reference, however. =back @@ -1462,15 +1504,8 @@ that name is a unique name generated internally by this module. It accepts the same C, C, and C parameters that C accepts. -Anonymous classes are destroyed once the metaclass they are attached -to goes out of scope, and will be removed from Perl's internal symbol -table. - -All instances of an anonymous class keep a special reference to the -metaclass object, which prevents the metaclass from going out of scope -while any instances exist. - -This only works if the instance is based on a hash reference, however. +Anonymous classes default to C<< weaken => 1 >>, although this can be +overridden. =item B<< Class::MOP::Class->initialize($package_name, %options) >>