use Class::MOP::Method::Wrapped;
use Class::MOP::Method::Accessor;
use Class::MOP::Method::Constructor;
-use Class::MOP::Class::Immutable::Class::MOP::Class;
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.87';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
: ref($super_meta);
($self->isa($super_meta_type))
- || confess "Class::MOP::class_of(" . $self->name . ") => ("
+ || confess "The metaclass of " . $self->name . " ("
. (ref($self)) . ")" . " is not compatible with the " .
- "Class::MOP::class_of(".$superclass_name . ") => ("
+ "metaclass of its superclass, ".$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 "Class::MOP::class_of(" . $self->name . ")->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
+ || confess "The instance metaclass for " . $self->name . " (" . ($self->instance_metaclass) . ")" .
" is not compatible with the " .
- "Class::MOP::class_of(" . $superclass_name . ")->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
+ "instance metaclass of its superclass, " . $superclass_name . " (" . ($super_meta->instance_metaclass) . ")";
}
}
return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
no warnings 'uninitialized';
- return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
+ my $name = $self->name;
+ return unless $name =~ /^$ANON_CLASS_PREFIX/;
# Moose does a weird thing where it replaces the metaclass for
# class when fixing metaclass incompatibility. In that case,
# we don't want to clean out the namespace now. We can detect
# that because Moose will explicitly update the singleton
# cache in Class::MOP.
- my $current_meta = Class::MOP::get_metaclass_by_name($self->name);
+ my $current_meta = Class::MOP::get_metaclass_by_name($name);
return if $current_meta ne $self;
- my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
+ my ($serial_id) = ($name =~ /^$ANON_CLASS_PREFIX(\d+)/);
no strict 'refs';
- foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
- delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
- }
- delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
+ @{$name . '::ISA'} = ();
+ %{$name . '::'} = ();
+ delete ${$ANON_CLASS_PREFIX}{$serial_id . '::'};
+
+ Class::MOP::remove_metaclass_by_name($name);
}
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_before_modifier(
- subname(':before' => $method_modifier)
+ subname(':before-' . $method_name => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_after_modifier(
- subname(':after' => $method_modifier)
+ subname(':after-' . $method_name => $method_modifier)
);
}
|| confess "You must pass in a method name";
my $method = $fetch_and_prepare_method->($self, $method_name);
$method->add_around_modifier(
- subname(':around' => $method_modifier)
+ subname(':around-' . $method_name => $method_modifier)
);
}
$trait, 'ForMetaClass', ref($self);
}
- if ( Class::MOP::is_class_loaded($class_name) ) {
- if ( $class_name->isa($trait) ) {
- return $class_name;
+ return $class_name
+ if Class::MOP::is_class_loaded($class_name);
+
+ # If the metaclass is a subclass of CMOP::Class which has had
+ # metaclass roles applied (via Moose), then we want to make sure
+ # that we preserve that anonymous class (see Fey::ORM for an
+ # example of where this matters).
+ my $meta_name
+ = $self->meta->is_immutable
+ ? $self->meta->get_mutable_metaclass_name
+ : ref $self->meta;
+
+ my $meta = $meta_name->create(
+ $class_name,
+ superclasses => [ ref $self ],
+ );
+
+ Class::MOP::load_class($trait);
+ for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
+ next if $meta->has_method( $meth->name );
+
+ if ( $meta->find_method_by_name( $meth->name ) ) {
+ $meta->add_around_method_modifier( $meth->name, $meth->body );
}
else {
- confess
- "$class_name is already defined but does not inherit $trait";
+ $meta->add_method( $meth->name, $meth->clone );
}
}
- else {
- my @super = ( $trait, ref($self) );
- my $meta = Class::MOP::Class->initialize($class_name);
- $meta->superclasses(@super);
+ $meta->make_immutable( inline_constructor => 0 );
- $meta->make_immutable;
-
- return $class_name;
- }
+ return $class_name;
}
sub _remove_inlined_code {
This method is used to create a new object of the metaclass's
class. Any parameters you provide are used to initialize the
instance's attributes. A special C<__INSTANCE__> key can be passed to
-provide an already generated instance, rather than having Moose
+provide an already generated instance, rather than having Class::MOP
generate it for you. This is mostly useful for using Class::MOP with
foreign classes, which generally generate instances using their own
-constructor. See L<Moose::Cookbook::Basics::Recipe11> for more information.
+constructor.
=item B<< $metaclass->instance_metaclass >>
projects / gitmo/Class-MOP.git / blobdiff