my $self = shift;
my ($old_meta) = @_;
- for my $method ($old_meta->_get_local_methods) {
- $self->_make_metaobject_compatible($method);
- $self->add_method($method->name => $method);
- }
-
- for my $attr (sort { $a->insertion_order <=> $b->insertion_order }
- map { $old_meta->get_attribute($_) }
- $old_meta->get_attribute_list) {
- $self->_make_metaobject_compatible($attr);
- $self->add_attribute($attr);
- }
+ $self->_restore_metamethods_from($old_meta);
+ $self->_restore_metaattributes_from($old_meta);
}
sub _remove_generated_metaobjects {
}
}
-sub _make_metaobject_compatible {
- my $self = shift;
- my ($object) = @_;
- my $current_single_meta_name = $self->_get_associated_single_metaclass($object);
- $object->_make_compatible_with($current_single_meta_name);
-}
-
-sub _get_associated_single_metaclass {
- my $self = shift;
- my ($single_meta_name) = @_;
-
- my $current_single_meta_name;
- if ($single_meta_name->isa('Class::MOP::Method')) {
- $current_single_meta_name = $self->method_metaclass;
- }
- elsif ($single_meta_name->isa('Class::MOP::Attribute')) {
- $current_single_meta_name = $self->attribute_metaclass;
- }
- else {
- confess "Can't make $single_meta_name compatible, it isn't an "
- . "attribute or method metaclass.";
- }
-
- return $current_single_meta_name;
-}
-
## ANON classes
{
keys %{ $self->_attribute_map };
}
+sub _restore_metaattributes_from {
+ my $self = shift;
+ my ($old_meta) = @_;
+
+ for my $attr (sort { $a->insertion_order <=> $b->insertion_order }
+ map { $old_meta->get_attribute($_) }
+ $old_meta->get_attribute_list) {
+ $attr->_make_compatible_with($self->attribute_metaclass);
+ $self->add_attribute($attr);
+ }
+}
+
1;
__END__
_class_metaclass_can_be_made_compatible
_single_metaclass_can_be_made_compatible
- _get_associated_single_metaclass
- _make_metaobject_compatible
_remove_generated_metaobjects
_restore_metaobjects_from