use strict;
use warnings;
+use Carp ();
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '1.03';
+our $VERSION = '1.19';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
$source .= "\n" . 'my $class = Scalar::Util::blessed($_instance) || $_instance;';
- $source .= "\n" . 'return $class->Moose::Object::new(@_)';
- $source .= "\n if \$class ne '" . $self->associated_metaclass->name
- . "';\n";
+ $source .= "\n" . "if (\$class ne '" . $self->associated_metaclass->name
+ . "') {";
+ $source .= "\n return "
+ . $self->_generate_fallback_constructor('$class') . ";";
+ $source .= "\n}\n";
$source .= $self->_generate_params('$params', '$class');
$source .= $self->_generate_instance('$instance', '$class');
defined $_ ? $_->_compiled_type_constraint : undef;
} @type_constraints;
+ my $defaults = [map { $_->default } @$attrs];
+
my ( $code, $e ) = $self->_compile_code(
code => $source,
environment => {
'$meta' => \$self,
'$attrs' => \$attrs,
+ '$defaults' => \$defaults,
'@type_constraints' => \@type_constraints,
'@type_constraint_bodies' => \@type_constraint_bodies,
},
$self->{'body'} = $code;
}
+sub _generate_fallback_constructor {
+ my ( $self, $class_var ) = @_;
+ "${class_var}->Moose::Object::new(\@_)";
+}
+
sub _generate_params {
my ( $self, $var, $class_var ) = @_;
"my $var = " . $self->_generate_BUILDARGS( $class_var, '@_' ) . ";\n";
sub _generate_instance {
my ( $self, $var, $class_var ) = @_;
"my $var = "
- . $self->_meta_instance->inline_create_instance($class_var) . ";\n";
+ . $self->associated_metaclass->inline_create_instance($class_var) . ";\n";
}
sub _generate_slot_initializers {
my $buildargs = $self->associated_metaclass->find_method_by_name("BUILDARGS");
- if ( $args eq '@_' and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS ) ) {
- return join("\n",
- 'do {',
- $self->_inline_throw_error('"Single parameters to new() must be a HASH ref"', 'data => $_[0]'),
- ' if scalar @_ == 1 && !( defined $_[0] && ref $_[0] eq q{HASH} );',
- '(scalar @_ == 1) ? {%{$_[0]}} : {@_};',
- '}',
- );
- } else {
+ if ( $args eq '@_'
+ and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS )
+ ) {
+
+ # This is the same logic as Moose::Object::BUILDARGS
+ return sprintf( <<'EOF', $self->_inline_throw_error( q{'Single parameters to new() must be a HASH ref'}, 'data => $_[0]' ) );
+do {
+ my $params;
+ if ( scalar @_ == 1 ) {
+ unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
+ %s
+ }
+ $params = { %%{ $_[0] } };
+ }
+ elsif ( @_ %% 2 ) {
+ Carp::carp(
+ "The new() method for $class expects a hash reference or a key/value list."
+ . " You passed an odd number of arguments" );
+ $params = { @_, undef };
+ }
+ else {
+ $params = {@_};
+ }
+ $params
+};
+EOF
+ ;
+ }
+ else {
return $class . "->BUILDARGS($args)";
}
}
. $i
. ']->trigger->('
. '$instance, '
- . $self->_meta_instance->inline_get_slot_value(
- '$instance',
- $attr->name,
- )
+ . $attr->inline_get('$instance')
. ', '
. ');' . "\n}";
}
my $source;
- if ($attr->has_initializer) {
- $source = (
- '$attrs->[' . $index . ']->set_initial_value($instance, ' . $value . ');'
- );
+ if ( $attr->has_initializer ) {
+ return
+ '$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 .= (
- "\n" .
- $self->_meta_instance->inline_weaken_slot_value(
- '$instance',
- $attr->name
- ) .
- ' if ref ' . $value . ';'
- );
+ return $attr->inline_set(
+ '$instance',
+ $value
+ ) . ';';
}
return $source;
);
}
-sub _generate_default_value {
- my ($self, $attr, $index) = @_;
- # NOTE:
- # default values can either be CODE refs
- # in which case we need to call them. Or
- # they can be scalars (strings/numbers)
- # in which case we can just deal with them
- # in the code we eval.
- if ($attr->is_default_a_coderef) {
- return '$attrs->[' . $index . ']->default($instance)';
- }
- else {
- return q{"} . quotemeta( $attr->default ) . q{"};
- }
-}
-
1;
__END__