use Scalar::Util 'blessed', 'reftype', 'weaken';
use Sub::Name 'subname';
-our $VERSION = '0.26';
+our $VERSION = '0.28';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Module';
my $meta_instance = $class->get_meta_instance();
my $clone = $meta_instance->clone_instance($instance);
foreach my $attr ($class->compute_all_applicable_attributes()) {
- if (exists $params{$attr->init_arg}) {
- $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});
+ if ( defined( my $init_arg = $attr->init_arg ) ) {
+ if (exists $params{$init_arg}) {
+ $attr->set_value($clone, $params{$init_arg});
+ }
}
}
return $clone;
sub rebless_instance {
my ($self, $instance) = @_;
- my $old_metaclass = $instance->meta();
+
+ 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(blessed($instance));
+ }
+
my $meta_instance = $self->get_meta_instance();
$self->name->isa($old_metaclass->name)
- || confess "You may rebless only into a subclass. (". $self->name .") is not a subclass of (". $old_metaclass->name .").";
+ || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't.";
# rebless!
$meta_instance->rebless_instance_structure($instance, $self);
- # check and upgrade all attributes
- my %params = map { $_->name => $meta_instance->get_slot_value($instance, $_->name) }
- grep { $meta_instance->is_slot_initialized($instance, $_->name) }
- $self->compute_all_applicable_attributes;
+ my %params;
+
+ foreach my $attr ( $self->compute_all_applicable_attributes ) {
+ if ( $attr->has_value($instance) ) {
+ if ( defined( my $init_arg = $attr->init_arg ) ) {
+ $params{$init_arg} = $attr->get_value($instance);
+ } else {
+ $attr->set_value($instance);
+ }
+ }
+ }
foreach my $attr ($self->compute_all_applicable_attributes) {
$attr->initialize_instance_slot($meta_instance, $instance, \%params);
}
}
+sub get_attribute_values {
+ my ($self, $instance) = @_;
+
+ return +{
+ map { $_->name => $_->get_value($instance) }
+ grep { $_->has_value($instance) }
+ $self->compute_all_applicable_attributes
+ };
+}
+
+sub get_init_args {
+ my ($self, $instance) = @_;
+
+ return +{
+ map { $_->init_arg => $_->get_value($instance) }
+ grep { $_->has_value($instance) }
+ grep { defined($_->init_arg) }
+ $self->compute_all_applicable_attributes
+ };
+}
+
# Inheritance
sub superclasses {
think Yuval "nothingmuch" Kogman put it best when he said that cloning
is too I<context-specific> to be part of the MOP.
+=item B<get_attribute_values($instance)>
+
+Returns the values of the C<$instance>'s fields keyed by the attribute names.
+
+=item B<get_init_args($instance)>
+
+Returns a hash reference where the keys are all the attributes' C<init_arg>s
+and the values are the instance's fields. Attributes without an C<init_arg>
+will be skipped.
+
=item B<rebless_instance($instance)>
This will change the class of C<$instance> to the class of the invoking