use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78';
+our $VERSION = '0.79';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
: 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) . ")";
}
}
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.";
+
+ $old_metaclass->rebless_instance_away($instance, $self, %params)
+ if $old_metaclass;
- $self->name->isa($old_metaclass->name)
- || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't.";
+ my $meta_instance = $self->get_meta_instance();
# rebless!
# we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
$instance;
}
+sub rebless_instance_away {
+ # this intentionally does nothing, it is just a hook
+}
+
# Inheritance
sub superclasses {
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',
},
);
- 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 {
attributes. Any existing attributes that are already set will be
overwritten.
+Before reblessing the instance, this method will call
+C<rebless_instance_away> on the instance's current metaclass. This method
+will be passed the instance, the new metaclass, and any parameters
+specified to C<rebless_instance>. By default, C<rebless_instance_away>
+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