X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=482797eeda0231be30ff392b21250385b6e88c71;hb=6d49ce629119cba81ea3791a4ad01c5d2c3ae4df;hp=249d6a872522006c5a4fc8616c9095a66532a879;hpb=44d6ea77ff5ddf47824a680d3fe11a2263290ed0;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 249d6a8..482797e 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -11,7 +11,7 @@ use Class::MOP::Method::Wrapped; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.78'; +our $VERSION = '0.79'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -169,16 +169,17 @@ sub check_metaclass_compatibility { : ref($super_meta); ($self->isa($super_meta_type)) - || confess $self->name . "->meta => (" . (ref($self)) . ")" . - " is not compatible with the " . - $superclass_name . "->meta => (" . ($super_meta_type) . ")"; + || confess "Class::MOP::class_of(" . $self->name . ") => (" + . (ref($self)) . ")" . " is not compatible with the " . + "Class::MOP::class_of(".$superclass_name . ") => (" + . ($super_meta_type) . ")"; # NOTE: # we also need to check that instance metaclasses # are compatibile in the same the class. ($self->instance_metaclass->isa($super_meta->instance_metaclass)) - || confess $self->name . "->meta->instance_metaclass => (" . ($self->instance_metaclass) . ")" . + || confess "Class::MOP::class_of(" . $self->name . ")->instance_metaclass => (" . ($self->instance_metaclass) . ")" . " is not compatible with the " . - $superclass_name . "->meta->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")"; + "Class::MOP::class_of(" . $superclass_name . ")->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")"; } } @@ -404,20 +405,16 @@ sub clone_instance { sub rebless_instance { my ($self, $instance, %params) = @_; - my $old_metaclass; - if ($instance->can('meta')) { - ($instance->meta->isa('Class::MOP::Class')) - || confess 'Cannot rebless instance if ->meta is not an instance of Class::MOP::Class'; - $old_metaclass = $instance->meta; - } - else { - $old_metaclass = $self->initialize(ref($instance)); - } + my $old_metaclass = Class::MOP::class_of($instance); - my $meta_instance = $self->get_meta_instance(); + my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance); + $self->name->isa($old_class) + || confess "You may rebless only into a subclass of ($old_class), of which (". $self->name .") isn't."; - $self->name->isa($old_metaclass->name) - || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't."; + $old_metaclass->rebless_instance_away($instance, $self, %params) + if $old_metaclass; + + my $meta_instance = $self->get_meta_instance(); # rebless! # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8 @@ -442,6 +439,10 @@ sub rebless_instance { $instance; } +sub rebless_instance_away { + # this intentionally does nothing, it is just a hook +} + # Inheritance sub superclasses { @@ -975,18 +976,31 @@ sub is_immutable { 0 } sub immutable_transformer { $_[0]->{immutable_transformer} } sub _set_immutable_transformer { $_[0]->{immutable_transformer} = $_[1] } +sub make_immutable { + my $self = shift; + + return if $self->is_immutable; + + my $transformer = $self->immutable_transformer + || $self->_make_immutable_transformer(@_); + + $self->_set_immutable_transformer($transformer); + + $transformer->make_metaclass_immutable; +} + { my %Default_Immutable_Options = ( read_only => [qw/superclasses/], cannot_call => [ - qw/ + qw( add_method alias_method remove_method add_attribute remove_attribute remove_package_symbol - / + ) ], memoize => { class_precedence_list => 'ARRAY', @@ -1019,22 +1033,19 @@ sub _set_immutable_transformer { $_[0]->{immutable_transformer} = $_[1] } }, ); - sub make_immutable { - my $self = shift; - - return if $self->is_immutable; - - my $transformer = $self->immutable_transformer - || Class::MOP::Immutable->new( - $self, - %Default_Immutable_Options, - @_ - ); + sub _default_immutable_transformer_options { + return %Default_Immutable_Options; + } +} - $self->_set_immutable_transformer($transformer); +sub _make_immutable_transformer { + my $self = shift; - $transformer->make_metaclass_immutable; - } + Class::MOP::Immutable->new( + $self, + $self->_default_immutable_transformer_options, + @_ + ); } sub make_mutable { @@ -1091,11 +1102,11 @@ Class::MOP::Class - Class Meta Object =head1 DESCRIPTION -This is the largest and most complex part of the Class::MOP -meta-object protocol. It controls the introspection and manipulation -of Perl 5 classes, and it can create them as wlel. The best way to -understand what this module can do, is to read the documentation for -each of its methods. +The Class Protocol is the largest and most complex part of the +Class::MOP meta-object protocol. It controls the introspection and +manipulation of Perl 5 classes, and it can create them as well. The +best way to understand what this module can do, is to read the +documentation for each of its methods. =head1 INHERITANCE @@ -1203,7 +1214,7 @@ instances. This method clones an existing object instance. Any parameters you provide are will override existing attribute values in the object. -This is a convience method for cloning an object instance, then +This is a convenience method for cloning an object instance, then blessing it into the appropriate package. You could implement a clone method in your class, using this method: @@ -1223,6 +1234,12 @@ like constructor parameters and used to initialize the object's attributes. Any existing attributes that are already set will be overwritten. +Before reblessing the instance, this method will call +C on the instance's current metaclass. This method +will be passed the instance, the new metaclass, and any parameters +specified to C. By default, C +does nothing; it is merely a hook. + =item B<< $metaclass->new_object(%params) >> This method is used to create a new object of the metaclass's @@ -1233,7 +1250,7 @@ instance's attributes. Returns the class name of the instance metaclass, see L for more information on the instance -metaclasses. +metaclass. =item B<< $metaclass->get_meta_instance >> @@ -1398,6 +1415,17 @@ track the original source of any methods added from other classes Remove the named method from the class. This method returns the L object for the method. +=item B<< $metaclass->method_metaclass >> + +Returns the class name of the method metaclass, see +L for more information on the method metaclass. + +=item B<< $metaclass->wrapped_method_metaclass >> + +Returns the class name of the wrapped method metaclass, see +L for more information on the wrapped +method metaclass. + =back =head2 Attribute introspection and creation @@ -1486,7 +1514,7 @@ Making a class immutable "freezes" the class definition. You can no longer call methods which alter the class, such as adding or removing methods or attributes. -Making a class immutable lets us optimize the class by inlning some +Making a class immutable lets us optimize the class by inlining some methods, and also allows us to optimize some methods on the metaclass object itself. @@ -1530,8 +1558,8 @@ parent classes. Method modifiers work by wrapping the original method and then replacing it in the class's symbol table. The wrappers will handle -calling all the modifiers in the appropariate orders and preserving -the calling context for the original method. +calling all the modifiers in the appropriate order and preserving the +calling context for the original method. The return values of C and C modifiers are ignored. This is because their purpose is B to filter the input @@ -1623,6 +1651,20 @@ The return value of the modifier is what will be seen by the caller. =back +=head2 Introspection + +=over 4 + +=item B<< Class::MOP::Class->meta >> + +This will return a L instance for this class. + +It should also be noted that L will actually bootstrap +this module by installing a number of attribute meta-objects into its +metaclass. + +=back + =head1 AUTHORS Stevan Little Estevan@iinteractive.comE