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);
);
push @initial_value, (
- '$attrs->[' . $idx . ']->set_initial_value(',
+ '$attrs[' . $idx . ']->set_initial_value(',
'$instance,',
$attr->_inline_instance_get('$instance'),
');',
my @initial_value = $attr->_inline_set_value('$instance', $default);
push @initial_value, (
- '$attrs->[' . $idx . ']->set_initial_value(',
+ '$attrs[' . $idx . ']->set_initial_value(',
'$instance,',
$attr->_inline_instance_get('$instance'),
');',
# in which case we can just deal with them
# in the code we eval.
if ($attr->is_default_a_coderef) {
- return '$defaults->[' . $index . ']->($instance)';
+ return '$defaults[' . $index . ']->($instance)';
}
else {
- return '$defaults->[' . $index . ']';
+ return '$defaults[' . $index . ']';
}
}
elsif ($attr->has_builder) {
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,
}
}
+sub _method_lookup_order {
+ return (shift->linearized_isa, 'UNIVERSAL');
+}
+
## Methods
{
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->_method_lookup_order) {
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 ( reverse $self->_method_lookup_order ) {
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->_method_lookup_order) {
# 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->_method_lookup_order);
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 ) = @_;
+ return $self unless $self->is_mutable;
+
my ($file, $line) = (caller)[1..2];
- if ( $self->is_mutable ) {
- $self->_initialize_immutable(
- $self->_immutable_options(@args),
- file => $file,
- line => $line,
- );
- $self->_rebless_as_immutable(@args);
- return $self;
- }
- else {
- return;
- }
+
+ $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,
my $destructor_class = $args{destructor_class};
- Class::MOP::load_class($destructor_class);
+ load_class($destructor_class);
return unless $destructor_class->is_needed($self);
=back
+=head2 Overload introspection and creation
+
+These methods provide an API to the core L<overload> functionality.
+
+=over 4
+
+=item B<< $metaclass->is_overloaded >>
+
+Returns true if overloading is enabled for this class. Corresponds to
+L<overload::Overloaded|overload/Public Functions>.
+
+=item B<< $metaclass->get_overloaded_operator($op) >>
+
+Returns the L<Class::MOP::Method::Overload> object corresponding to the
+operator named C<$op>, if one exists for this class.
+
+=item B<< $metaclass->has_overloaded_operator($op) >>
+
+Returns whether or not the operator C<$op> is overloaded for this class.
+
+=item B<< $metaclass->get_overload_list >>
+
+Returns a list of operator names which have been overloaded (see
+L<overload/Overloadable Operations> for the list of valid operator names).
+
+=item B<< $metaclass->get_all_overloaded_operators >>
+
+Returns a list of L<Class::MOP::Method::Overload> objects corresponding to the
+operators that have been overloaded.
+
+=item B<< $metaclass->add_overloaded_operator($op, $impl) >>
+
+Overloads the operator C<$op> for this class, with the implementation C<$impl>.
+C<$impl> can be either a coderef or a method name. Corresponds to
+C<< use overload $op => $impl; >>
+
+=item B<< $metaclass->remove_overloaded_operator($op) >>
+
+Remove overloading for operator C<$op>. Corresponds to C<< no overload $op; >>
+
+=back
+
=head2 Class Immutability
Making a class immutable "freezes" the class definition. You can no
=item B<< $metaclass->make_immutable(%options) >>
This method will create an immutable transformer and use it to make
-the class and its metaclass object immutable.
+the class and its metaclass object immutable, and returns true
+(you should not rely on the details of this value apart from its truth).
This method accepts the following options: