use strict;
use warnings;
-use Class::MOP ();
use B ();
+use Class::Load qw(is_class_loaded load_class);
use Scalar::Util 'blessed', 'weaken';
use List::MoreUtils 'any';
use Try::Tiny;
sub new {
my ($class, $name, %options) = @_;
$class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
-
+
delete $options{__hack_no_process_options};
my %attrs =
if (my $traits = $options->{traits}) {
my $i = 0;
+ my $has_foreign_options = 0;
+
while ($i < @$traits) {
my $trait = $traits->[$i++];
next if ref($trait); # options to a trait we discarded
push @traits, $trait;
# are there options?
- push @traits, $traits->[$i++]
- if $traits->[$i] && ref($traits->[$i]);
+ if ($traits->[$i] && ref($traits->[$i])) {
+ $has_foreign_options = 1
+ if any { $_ ne '-alias' && $_ ne '-excludes' } keys %{ $traits->[$i] };
+
+ push @traits, $traits->[$i++];
+ }
}
if (@traits) {
- my $anon_class = Moose::Meta::Class->create_anon_class(
+ my %options = (
superclasses => [ $class ],
roles => [ @traits ],
- cache => 1,
);
+ if ($has_foreign_options) {
+ $options{weaken} = 0;
+ }
+ else {
+ $options{cache} = 1;
+ }
+
+ my $anon_class = Moose::Meta::Class->create_anon_class(%options);
$class = $anon_class->name;
}
}
return '$trigger->(' . $instance . ', ' . $value . ', ' . $old . ');';
}
+sub _eval_environment {
+ my $self = shift;
+
+ my $env = { };
+
+ $env->{'$trigger'} = \($self->trigger)
+ if $self->has_trigger;
+ $env->{'$attr_default'} = \($self->default)
+ if $self->has_default;
+
+ if ($self->has_type_constraint) {
+ my $tc_obj = $self->type_constraint;
+
+ $env->{'$type_constraint'} = \(
+ $tc_obj->_compiled_type_constraint
+ ) unless $tc_obj->can_be_inlined;
+ # these two could probably get inlined versions too
+ $env->{'$type_coercion'} = \(
+ $tc_obj->coercion->_compiled_type_coercion
+ ) if $tc_obj->has_coercion;
+ $env->{'$type_message'} = \(
+ $tc_obj->has_message ? $tc_obj->message : $tc_obj->_default_message
+ );
+
+ $env = { %$env, %{ $tc_obj->inline_environment } };
+ }
+
+ # XXX ugh, fix these
+ $env->{'$attr'} = \$self
+ if $self->has_initializer && $self->is_lazy;
+ # pretty sure this is only going to be closed over if you use a custom
+ # error class at this point, but we should still get rid of this
+ # at some point
+ $env->{'$meta'} = \($self->associated_class);
+
+ return $env;
+}
+
sub _weaken_value {
my ( $self, $instance ) = @_;
my ($instance, $default) = @_;
if ($self->has_default) {
- my $source = 'my ' . $default . ' = $default';
+ my $source = 'my ' . $default . ' = $attr_default';
$source .= '->(' . $instance . ')'
if $self->is_default_a_coderef;
return $source . ';';
# install the delegation ...
my $associated_class = $self->associated_class;
- foreach my $handle (keys %handles) {
+ foreach my $handle (sort keys %handles) {
my $method_to_call = $handles{$handle};
my $class_name = $associated_class->name;
my $name = "${class_name}::${handle}";
}
}
- Class::MOP::load_class($handles);
+ load_class($handles);
my $role_meta = Class::MOP::class_of($handles);
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
sub _find_delegate_metaclass {
my $self = shift;
if (my $class = $self->_isa_metadata) {
- unless ( Class::MOP::is_class_loaded($class) ) {
+ unless ( is_class_loaded($class) ) {
$self->throw_error(
sprintf(
'The %s attribute is trying to delegate to a class which has not been loaded - %s',
return Class::MOP::Class->initialize($class);
}
elsif (my $role = $self->_does_metadata) {
- unless ( Class::MOP::is_class_loaded($class) ) {
+ unless ( is_class_loaded($class) ) {
$self->throw_error(
sprintf(
'The %s attribute is trying to delegate to a role which has not been loaded - %s',