use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.06';
+our $VERSION = '0.11';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
(exists $options{options} && ref $options{options} eq 'HASH')
|| confess "You must pass a hash of options";
+ ($options{package_name} && $options{name})
+ || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
+
my $self = bless {
# from our superclass
- '&!body' => undef,
+ '&!body' => undef,
+ '$!package_name' => $options{package_name},
+ '$!name' => $options{name},
# specific to this subclass
'%!options' => $options{options},
'$!meta_instance' => $options{metaclass}->get_meta_instance,
# needed
weaken($self->{'$!associated_metaclass'});
- $self->intialize_body;
+ $self->initialize_body;
return $self;
}
## method
-sub intialize_body {
+# this was changed in 0.41, but broke MooseX::Singleton, so try to catch
+# any other code using the original broken spelling
+sub intialize_body { confess "Please correct the spelling of 'intialize_body' to 'initialize_body'" }
+
+sub initialize_body {
my $self = shift;
# TODO:
# the %options should also include a both
$self->_generate_slot_initializer($_)
} 0 .. (@{$self->attributes} - 1));
+ $source .= ";\n" . $self->_generate_triggers();
$source .= ";\n" . $self->_generate_BUILDALL();
$source .= ";\n" . 'return $instance';
# We need to check if the attribute ->can('type_constraint')
# since we may be trying to immutabilize a Moose meta class,
# which in turn has attributes which are Class::MOP::Attribute
- # objects, rather than
- # Moose::Meta::Attribute. Class::MOP::Attribute attributes
- # have no type constraints.
- my @type_constraints = map { $_->type_constraint } grep { $_->can('type_constraint') } @$attrs;
+ # objects, rather than Moose::Meta::Attribute. And
+ # Class::MOP::Attribute attributes have no type constraints.
+ # However we need to make sure we leave an undef value there
+ # because the inlined code is using the index of the attributes
+ # to determine where to find the type constraint
+
+ my @type_constraints = map {
+ $_->can('type_constraint') ? $_->type_constraint : undef
+ } @$attrs;
+
my @type_constraint_bodies = map {
- $_ && $_->_compiled_type_constraint;
+ defined $_ ? $_->_compiled_type_constraint : undef;
} @type_constraints;
$code = eval $source;
return join ";\n" => @BUILD_calls;
}
+sub _generate_triggers {
+ my $self = shift;
+ my @trigger_calls;
+ foreach my $i (0 .. $#{ $self->attributes }) {
+ my $attr = $self->attributes->[$i];
+ if ($attr->can('has_trigger') && $attr->has_trigger) {
+ if (defined(my $init_arg = $attr->init_arg)) {
+ push @trigger_calls => (
+ '(exists $params{\'' . $init_arg . '\'}) && do {' . "\n "
+ . '$attrs->[' . $i . ']->trigger->('
+ . '$instance, '
+ . $self->meta_instance->inline_get_slot_value(
+ '$instance',
+ ("'" . $attr->name . "'")
+ )
+ . ', '
+ . '$attrs->[' . $i . ']'
+ . ');'
+ ."\n}"
+ );
+ }
+ }
+ }
+ return join ";\n" => @trigger_calls;
+}
+
sub _generate_slot_initializer {
my $self = shift;
my $index = shift;
my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
- if ($is_moose && $attr->is_required && !$attr->has_default && !$attr->has_builder) {
+ if ($is_moose && defined($attr->init_arg) && $attr->is_required && !$attr->has_default && !$attr->has_builder) {
push @source => ('(exists $params{\'' . $attr->init_arg . '\'}) ' .
'|| confess "Attribute (' . $attr->name . ') is required";');
}
if (($attr->has_default || $attr->has_builder) && !($is_moose && $attr->is_lazy)) {
- push @source => 'if (exists $params{\'' . $attr->init_arg . '\'}) {';
-
- push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
- if ($is_moose && $attr->has_type_constraint) {
- if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
- push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
+ if ( defined( my $init_arg = $attr->init_arg ) ) {
+ push @source => 'if (exists $params{\'' . $init_arg . '\'}) {';
+
+ push @source => ('my $val = $params{\'' . $init_arg . '\'};');
+
+ if ($is_moose && $attr->has_type_constraint) {
+ if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
+ push @source => $self->_generate_type_coercion(
+ $attr,
+ '$type_constraints[' . $index . ']',
+ '$val',
+ '$val'
+ );
+ }
+ push @source => $self->_generate_type_constraint_check(
+ $attr,
+ '$type_constraint_bodies[' . $index . ']',
+ '$type_constraints[' . $index . ']',
+ '$val'
+ );
}
- push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
- }
- push @source => $self->_generate_slot_assignment($attr, '$val');
-
- push @source => "} else {";
+ push @source => $self->_generate_slot_assignment($attr, '$val', $index);
+ push @source => "} else {";
+ }
my $default;
if ( $attr->has_default ) {
$default = $self->_generate_default_value($attr, $index);
my $builder = $attr->builder;
$default = '$instance->' . $builder;
}
+
+ push @source => '{'; # wrap this to avoid my $val overwrite warnings
push @source => ('my $val = ' . $default . ';');
push @source => $self->_generate_type_constraint_check(
$attr,
('$type_constraint_bodies[' . $index . ']'),
+ ('$type_constraints[' . $index . ']'),
'$val'
) if ($is_moose && $attr->has_type_constraint);
- push @source => $self->_generate_slot_assignment($attr, $default);
+
+ push @source => $self->_generate_slot_assignment($attr, '$val', $index);
+ push @source => '}'; # close - wrap this to avoid my $val overrite warnings
- push @source => "}";
+ push @source => "}" if defined $attr->init_arg;
}
- else {
- push @source => '(exists $params{\'' . $attr->init_arg . '\'}) && do {';
+ elsif ( defined( my $init_arg = $attr->init_arg ) ) {
+ push @source => '(exists $params{\'' . $init_arg . '\'}) && do {';
- push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
+ push @source => ('my $val = $params{\'' . $init_arg . '\'};');
if ($is_moose && $attr->has_type_constraint) {
if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
- push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
+ push @source => $self->_generate_type_coercion(
+ $attr,
+ '$type_constraints[' . $index . ']',
+ '$val',
+ '$val'
+ );
}
- push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
+ push @source => $self->_generate_type_constraint_check(
+ $attr,
+ '$type_constraint_bodies[' . $index . ']',
+ '$type_constraints[' . $index . ']',
+ '$val'
+ );
}
- push @source => $self->_generate_slot_assignment($attr, '$val');
+ push @source => $self->_generate_slot_assignment($attr, '$val', $index);
push @source => "}";
}
}
sub _generate_slot_assignment {
- my ($self, $attr, $value) = @_;
- my $source = (
- $self->meta_instance->inline_set_slot_value(
- '$instance',
- ("'" . $attr->name . "'"),
- $value
- ) . ';'
- );
-
- my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
+ my ($self, $attr, $value, $index) = @_;
+
+ my $source;
+
+ if ($attr->has_initializer) {
+ $source = (
+ '$attrs->[' . $index . ']->set_initial_value($instance, ' . $value . ');'
+ );
+ }
+ else {
+ $source = (
+ $self->meta_instance->inline_set_slot_value(
+ '$instance',
+ ("'" . $attr->name . "'"),
+ $value
+ ) . ';'
+ );
+ }
+
+ my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
if ($is_moose && $attr->is_weak_ref) {
$source .= (
}
sub _generate_type_constraint_check {
- my ($self, $attr, $type_constraint_cv, $value_name) = @_;
+ my ($self, $attr, $type_constraint_cv, $type_constraint_obj, $value_name) = @_;
return (
$type_constraint_cv . '->(' . $value_name . ')'
- . "\n\t" . '|| confess "Attribute (' . $attr->name . ') does not pass the type constraint ('
- . $attr->type_constraint->name
- . ') with " . (defined(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : "undef");'
+ . "\n\t" . '|| confess "Attribute ('
+ . $attr->name
+ . ') does not pass the type constraint because: " . '
+ . $type_constraint_obj . '->get_message(' . $value_name . ');'
);
}
=item B<options>
-=item B<intialize_body>
+=item B<initialize_body>
=item B<associated_metaclass>