X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FConstructor.pm;h=3435a333710bf646de1ba9f6cab2e4f1deb44dc3;hb=f4b86ac0e1fd7ff8a180f2f8332821170db5371e;hp=e25ae44dc987bf2cfaba9e5fd1d45b74de322591;hpb=62c8675ec025457cc82e7d774d9f9edeb6721e83;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index e25ae44..3435a33 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -4,9 +4,10 @@ package Moose::Meta::Method::Constructor; use strict; use warnings; +use Carp (); use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr'; -our $VERSION = '0.89_02'; +our $VERSION = '1.16'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -57,14 +58,13 @@ sub _initialize_body { 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'); @@ -96,11 +96,14 @@ sub _initialize_body { 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, }, @@ -114,6 +117,11 @@ sub _initialize_body { $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"; @@ -122,7 +130,7 @@ sub _generate_params { 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 { @@ -137,15 +145,35 @@ sub _generate_BUILDARGS { 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)"; } } @@ -179,10 +207,7 @@ sub _generate_triggers { . $i . ']->trigger->(' . '$instance, ' - . $self->_meta_instance->inline_get_slot_value( - '$instance', - $attr->name, - ) + . $attr->inline_get('$instance') . ', ' . ');' . "\n}"; } @@ -202,7 +227,7 @@ sub _generate_slot_initializer { 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)) { @@ -266,32 +291,18 @@ sub _generate_slot_assignment { 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; @@ -329,29 +340,13 @@ sub _generate_type_constraint_check { 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__ @@ -364,24 +359,28 @@ Moose::Meta::Method::Constructor - Method Meta Object for constructors =head1 DESCRIPTION -This class is a subclass of L that +This class is a subclass of L that provides additional Moose-specific functionality To understand this class, you should read the the -L documentation as well. +L documentation as well. =head1 INHERITANCE C is a subclass of L I L. +=head1 BUGS + +See L for details on reporting bugs. + =head1 AUTHORS Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L