From: Yuval Kogman Date: Mon, 14 Jul 2008 19:35:53 +0000 (+0000) Subject: Constructor throw_error X-Git-Tag: 0.58~54^2~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3e504337fbb00a184ddca0bb0a1baeacd3e6e7e2;p=gitmo%2FMoose.git Constructor throw_error --- diff --git a/lib/Moose/Meta/Method.pm b/lib/Moose/Meta/Method.pm index 9551bea..8013f76 100644 --- a/lib/Moose/Meta/Method.pm +++ b/lib/Moose/Meta/Method.pm @@ -8,9 +8,15 @@ our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method'; +sub _error_thrower { + my $self = shift; + return "Moose::Meta::Class"; + #( $self->associated_attribute || $self->associated_class ) # FIXME move to Accessor, fix for Constructor +} + sub throw_error { my $self = shift; - my $inv = ( ref $self && ( $self->associated_attribute || $self->associated_class ) ) || "Moose::Meta::Class"; + my $inv = $self->_error_thrower; unshift @_, "message" if @_ % 2 == 1; unshift @_, method => $self if ref $self; unshift @_, $inv; diff --git a/lib/Moose/Meta/Method/Augmented.pm b/lib/Moose/Meta/Method/Augmented.pm index 50f9bd8..7d86a77 100644 --- a/lib/Moose/Meta/Method/Augmented.pm +++ b/lib/Moose/Meta/Method/Augmented.pm @@ -23,7 +23,7 @@ sub new { my $super = $meta->find_next_method_by_name($name); (defined $super) - || confess "You cannot augment '$name' because it has no super method"; + || $meta->throw_error("You cannot augment '$name' because it has no super method", data => $name); my $_super_package = $super->package_name; # BUT!,... if this is an overriden method .... diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index 54921cd..4b74983 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -4,7 +4,6 @@ package Moose::Meta::Method::Constructor; use strict; use warnings; -use Carp 'confess'; use Scalar::Util 'blessed', 'weaken', 'looks_like_number'; our $VERSION = '0.50'; @@ -17,11 +16,13 @@ sub new { my $class = shift; my %options = @_; - (exists $options{options} && ref $options{options} eq 'HASH') - || confess "You must pass a hash of options"; + my $meta = $options{metaclass}; + + (ref $options{options} eq 'HASH') + || $meta->throw_error("You must pass a hash of options", data => $options{options}); ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; + || $meta->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"); my $self = bless { # from our superclass @@ -30,10 +31,10 @@ sub new { '$!name' => $options{name}, # specific to this subclass '%!options' => $options{options}, - '$!meta_instance' => $options{metaclass}->get_meta_instance, - '@!attributes' => [ $options{metaclass}->compute_all_applicable_attributes ], + '$!meta_instance' => $meta->get_meta_instance, + '@!attributes' => [ $meta->compute_all_applicable_attributes ], # ... - '$!associated_metaclass' => $options{metaclass}, + '$!associated_metaclass' => $meta, } => $class; # we don't want this creating @@ -58,7 +59,7 @@ sub associated_metaclass { (shift)->{'$!associated_metaclass'} } # 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 intialize_body { Carp::confess "Please correct the spelling of 'intialize_body' to 'initialize_body'" } sub initialize_body { my $self = shift; @@ -75,8 +76,8 @@ sub initialize_body { $source .= "\n" . 'return $class->Moose::Object::new(@_)'; $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';'; - $source .= "\n" . 'confess "Single parameters to new() must be a HASH ref"'; - $source .= "\n" . ' if scalar @_ == 1 && defined $_[0] && ref($_[0]) ne q{HASH};'; + $source .= "\n" . $self->_inline_throw_error('"Single parameters to new() must be a HASH ref"', 'data => $_[0]'); + $source .= "\n" . ' if scalar @_ == 1 && ref($_[0]) ne q{HASH};'; $source .= "\n" . 'my %params = (scalar @_ == 1) ? %{$_[0]} : @_;'; @@ -95,6 +96,8 @@ sub initialize_body { my $code; { + my $meta = $self; # FIXME for _inline_throw_error... + # NOTE: # create the nessecary lexicals # to be picked up in the eval @@ -118,7 +121,7 @@ sub initialize_body { } @type_constraints; $code = eval $source; - confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@; + $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source ) if $@; } $self->{'&!body'} = $code; } @@ -170,7 +173,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 . '\'}) ' . - '|| confess "Attribute (' . $attr->name . ') is required";'); + '|| ' . $self->_inline_throw_error('"Attribute (' . $attr->name . ') is required"') .';'); } if (($attr->has_default || $attr->has_builder) && !($is_moose && $attr->is_lazy)) { @@ -295,11 +298,11 @@ sub _generate_type_coercion { sub _generate_type_constraint_check { my ($self, $attr, $type_constraint_cv, $type_constraint_obj, $value_name) = @_; return ( - $type_constraint_cv . '->(' . $value_name . ')' - . "\n\t" . '|| confess "Attribute (' + $self->_inline_throw_error('"Attribute (' # FIXME add 'dad' . $attr->name . ') does not pass the type constraint because: " . ' - . $type_constraint_obj . '->get_message(' . $value_name . ');' + . $type_constraint_obj . '->get_message(' . $value_name . ')') + . "\n\t unless " . $type_constraint_cv . '->(' . $value_name . ');' ); }