use Class::MOP::MiniTrait;
use Carp 'confess';
+use Class::Load 'is_class_loaded', 'load_class';
use Scalar::Util 'blessed', 'reftype', 'weaken';
use Sub::Name 'subname';
use Try::Tiny;
my $class = shift;
my $package_name;
-
+
if ( @_ % 2 ) {
$package_name = shift;
} else {
}
# and check the metaclass compatibility
- $meta->_check_metaclass_compatibility();
+ $meta->_check_metaclass_compatibility();
Class::MOP::store_metaclass_by_name($package_name, $meta);
sub _inline_extra_init { }
+sub _eval_environment {
+ my $self = shift;
+
+ my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
+
+ my $defaults = [map { $_->default } @attrs];
+
+ return {
+ '$defaults' => \$defaults,
+ };
+}
+
sub get_meta_instance {
my $self = shift;
sub _create_meta_instance {
my $self = shift;
-
+
my $instance = $self->instance_metaclass->new(
associated_metaclass => $self,
attributes => [ $self->get_all_attributes() ],
return $instance;
}
+# TODO: this is actually not being used!
sub _inline_rebless_instance {
my $self = shift;
}
# rebless!
- # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
+ # we use $_[1] here because of t/cmop/rebless_overload.t regressions
+ # on 5.8.8
$meta_instance->rebless_instance_structure($_[1], $self);
$self->_fixup_attributes_after_rebless($instance, $old_metaclass, %params);
my $self = shift;
my $name = $self->name;
- unless (Class::MOP::IS_RUNNING_ON_5_10()) {
+ unless (Class::MOP::IS_RUNNING_ON_5_10()) {
# NOTE:
# We need to check for circular inheritance here
- # if we are are not on 5.10, cause 5.8 detects it
- # late. This will do nothing if all is well, and
+ # if we are are not on 5.10, cause 5.8 detects it
+ # late. This will do nothing if all is well, and
# blow up otherwise. Yes, it's an ugly hack, better
- # suggestions are welcome.
+ # suggestions are welcome.
# - SL
- ($name || return)->isa('This is a test for circular inheritance')
+ ($name || return)->isa('This is a test for circular inheritance')
}
- # if our mro is c3, we can
+ # if our mro is c3, we can
# just grab the linear_isa
if (mro::get_mro($name) eq 'c3') {
return @{ mro::get_linear_isa($name) }
else {
# NOTE:
# we can't grab the linear_isa for dfs
- # since it has all the duplicates
+ # since it has all the duplicates
# already removed.
return (
$name,
my ($self, $method_name) = @_;
(defined $method_name && length $method_name)
|| confess "You must define a method name to find";
- foreach my $class ($self->linearized_isa) {
+ foreach my $class ($self->linearized_isa, 'UNIVERSAL') {
my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
return $method if defined $method;
}
my $self = shift;
my %methods;
- for my $class ( reverse $self->linearized_isa ) {
+ for my $class ( 'UNIVERSAL', reverse $self->linearized_isa ) {
my $meta = Class::MOP::Class->initialize($class);
$methods{ $_->name } = $_ for $meta->_get_local_methods;
sub get_all_method_names {
my $self = shift;
- my %uniq;
- return grep { !$uniq{$_}++ } map { Class::MOP::Class->initialize($_)->get_method_list } $self->linearized_isa;
+ map { $_->name } $self->get_all_methods;
}
sub find_all_methods_by_name {
(defined $method_name && length $method_name)
|| confess "You must define a method name to find";
my @methods;
- foreach my $class ($self->linearized_isa) {
+ foreach my $class ($self->linearized_isa, 'UNIVERSAL') {
# fetch the meta-class ...
my $meta = Class::MOP::Class->initialize($class);
push @methods => {
my ($self, $method_name) = @_;
(defined $method_name && length $method_name)
|| confess "You must define a method name to find";
- my @cpl = $self->linearized_isa;
+ my @cpl = ($self->linearized_isa, 'UNIVERSAL');
shift @cpl; # discard ourselves
foreach my $class (@cpl) {
my $method = Class::MOP::Class->initialize($class)->get_method($method_name);
sub make_immutable {
my ( $self, @args ) = @_;
- if ( $self->is_mutable ) {
- $self->_initialize_immutable( $self->_immutable_options(@args) );
- $self->_rebless_as_immutable(@args);
- return $self;
- }
- else {
- return;
- }
+ return unless $self->is_mutable;
+
+ my ($file, $line) = (caller)[1..2];
+
+ $self->_initialize_immutable(
+ file => $file,
+ line => $line,
+ $self->_immutable_options(@args),
+ );
+ $self->_rebless_as_immutable(@args);
+
+ return $self;
}
sub make_mutable {
}
return $class_name
- if Class::MOP::is_class_loaded($class_name);
+ if 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
my $constructor_class = $args{constructor_class};
- Class::MOP::load_class($constructor_class);
+ load_class($constructor_class);
my $constructor = $constructor_class->new(
options => \%args,
is_inline => 1,
package_name => $self->name,
name => $name,
+ definition_context => {
+ description => "constructor " . $self->name . "::" . $name,
+ file => $args{file},
+ line => $args{line},
+ },
);
if ( $args{replace_constructor} or $constructor->can_be_inlined ) {
my $destructor_class = $args{destructor_class};
- Class::MOP::load_class($destructor_class);
+ load_class($destructor_class);
return unless $destructor_class->is_needed($self);
options => \%args,
metaclass => $self,
package_name => $self->name,
- name => 'DESTROY'
+ name => 'DESTROY',
+ definition_context => {
+ description => "destructor " . $self->name . "::DESTROY",
+ file => $args{file},
+ line => $args{line},
+ },
);
if ( $args{replace_destructor} or $destructor->can_be_inlined ) {
projects / gitmo/Moose.git / blobdiff