use strict;
use warnings;
+use Carp ();
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '0.89_02';
+our $VERSION = '1.19';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
my $source = 'sub {';
$source .= "\n" . 'my $_instance = shift;';
- $source .= "\n" . q{Carp::cluck 'Calling new() on an instance is deprecated,'
- . ' please use (blessed $obj)->new' if blessed $_instance;};
-
$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}";
}
if ($is_moose && defined($attr->init_arg) && $attr->is_required && !$attr->has_default && !$attr->has_builder) {
push @source => ('(exists $params->{\'' . $attr->init_arg . '\'}) ' .
- '|| ' . $self->_inline_throw_error('"Attribute (' . $attr->name . ') is required"') .';');
+ '|| ' . $self->_inline_throw_error('"Attribute (' . quotemeta($attr->name) . ') is required"') .';');
}
if (($attr->has_default || $attr->has_builder) && !($is_moose && $attr->is_lazy)) {
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;
my ($self, $attr, $type_constraint_cv, $type_constraint_obj, $value_name) = @_;
return (
$self->_inline_throw_error('"Attribute (' # FIXME add 'dad'
- . $attr->name
+ . quotemeta( $attr->name )
. ') does not pass the type constraint because: " . '
. $type_constraint_obj . '->get_message(' . $value_name . ')')
. "\n\t unless " . $type_constraint_cv . '->(' . $value_name . ');'
);
}
-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__
=head1 DESCRIPTION
-This class is a subclass of L<Class::MOP::Class::Constructor> that
+This class is a subclass of L<Class::MOP::Method::Constructor> that
provides additional Moose-specific functionality
To understand this class, you should read the the
-L<Class::MOP::Class::Constructor> documentation as well.
+L<Class::MOP::Method::Constructor> documentation as well.
=head1 INHERITANCE
C<Moose::Meta::Method::Constructor> is a subclass of
L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Constructor>.
+=head1 BUGS
+
+See L<Moose/BUGS> for details on reporting bugs.
+
=head1 AUTHORS
Stevan Little E<lt>stevan@iinteractive.comE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Moose.git / blobdiff