# - SL
*does = \&Moose::Object::does;
+sub throw_error {
+ my $self = shift;
+ my $class = ( ref $self && $self->associated_class ) || "Moose::Meta::Class";
+ unshift @_, "message" if @_ % 2 == 1;
+ unshift @_, attr => $self if ref $self;
+ unshift @_, $class;
+ goto $class->can("throw_error"); # to avoid incrementing depth by 1
+}
+
sub new {
my ($class, $name, %options) = @_;
$class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
else {
$type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
(defined $type_constraint)
- || confess "Could not find the type constraint '" . $options{isa} . "'";
+ || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa});
}
$actual_options{type_constraint} = $type_constraint;
else {
$type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
(defined $type_constraint)
- || confess "Could not find the type constraint '" . $options{does} . "'";
+ || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does});
}
$actual_options{type_constraint} = $type_constraint;
}
(scalar keys %options == 0)
- || confess "Illegal inherited options => (" . (join ', ' => keys %options) . ")";
+ || $self->throw_error("Illegal inherited options => (" . (join ', ' => keys %options) . ")", data => \%options);
$self->clone(%actual_options);
=cut
if ($options->{is} eq 'ro') {
- confess "Cannot define an accessor name on a read-only attribute, accessors are read/write"
+ $class->throw_error("Cannot define an accessor name on a read-only attribute, accessors are read/write", data => $options)
if exists $options->{accessor};
$options->{reader} ||= $name;
}
}
}
else {
- confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name"
+ $class->throw_error("I do not understand this option (is => " . $options->{is} . ") on attribute $name", data => $options->{is});
}
}
if (exists $options->{does}) {
if (eval { $options->{isa}->can('does') }) {
($options->{isa}->does($options->{does}))
- || confess "Cannot have an isa option and a does option if the isa does not do the does on attribute $name";
+ || $class->throw_error("Cannot have an isa option and a does option if the isa does not do the does on attribute $name", data => $options);
}
else {
- confess "Cannot have an isa option which cannot ->does() on attribute $name";
+ $class->throw_error("Cannot have an isa option which cannot ->does() on attribute $name", data => $options);
}
}
if (exists $options->{coerce} && $options->{coerce}) {
(exists $options->{type_constraint})
- || confess "You cannot have coercion without specifying a type constraint on attribute $name";
- confess "You cannot have a weak reference to a coerced value on attribute $name"
+ || $class->throw_error("You cannot have coercion without specifying a type constraint on attribute $name", data => $options);
+ $class->throw_error("You cannot have a weak reference to a coerced value on attribute $name", data => $options)
if $options->{weak_ref};
}
if (exists $options->{trigger}) {
('CODE' eq ref $options->{trigger})
- || confess "Trigger must be a CODE ref";
+ || $class->throw_error("Trigger must be a CODE ref", data => $options->{trigger});
}
if (exists $options->{auto_deref} && $options->{auto_deref}) {
(exists $options->{type_constraint})
- || confess "You cannot auto-dereference without specifying a type constraint on attribute $name";
+ || $class->throw_error("You cannot auto-dereference without specifying a type constraint on attribute $name", data => $options);
($options->{type_constraint}->is_a_type_of('ArrayRef') ||
$options->{type_constraint}->is_a_type_of('HashRef'))
- || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name";
+ || $class->throw_error("You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name", data => $options);
}
if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
- confess("You can not use lazy_build and default for the same attribute $name")
+ $class->throw_error("You can not use lazy_build and default for the same attribute $name", data => $options)
if exists $options->{default};
$options->{lazy} = 1;
$options->{required} = 1;
if (exists $options->{lazy} && $options->{lazy}) {
(exists $options->{default} || defined $options->{builder} )
- || confess "You cannot have lazy attribute ($name) without specifying a default value for it";
+ || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it", data => $options);
}
if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) {
- confess "You cannot have a required attribute ($name) without a default, builder, or an init_arg";
+ $class->throw_error("You cannot have a required attribute ($name) without a default, builder, or an init_arg", data => $options);
}
}
# skip it if it's lazy
return if $self->is_lazy;
# and die if it's required and doesn't have a default value
- confess "Attribute (" . $self->name . ") is required"
+ $self->throw_error("Attribute (" . $self->name . ") is required", object => $instance, data => $params)
if $self->is_required && !$self->has_default && !$self->has_builder;
# if nothing was in the %params, we can use the
$value_is_set = 1;
}
else {
- confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
+ $self->throw_error(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'", object => $instance, data => $params);
}
}
}
$val = $type_constraint->coerce($val);
}
$type_constraint->check($val)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $self->name
. ") does not pass the type constraint because: "
- . $type_constraint->get_message($val);
+ . $type_constraint->get_message($val), data => $val, object => $instance);
}
$self->set_initial_value($instance, $val);
$val = $type_constraint->coerce($val)
if $can_coerce;
$type_constraint->check($val)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $slot_name
. ") does not pass the type constraint because: "
- . $type_constraint->get_message($val);
+ . $type_constraint->get_message($val), data => $val, object => $instance);
}
$meta_instance->set_slot_value($instance, $slot_name, $val);
};
my $attr_name = $self->name;
if ($self->is_required and not @args) {
- confess "Attribute ($attr_name) is required";
+ $self->throw_error("Attribute ($attr_name) is required", object => $instance);
}
if ($self->has_type_constraint) {
$value = $type_constraint->coerce($value);
}
$type_constraint->_compiled_type_constraint->($value)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $self->name
. ") does not pass the type constraint because "
- . $type_constraint->get_message($value);
+ . $type_constraint->get_message($value), object => $instance, data => $value);
}
my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
$self->set_initial_value($instance, $instance->$builder);
}
else {
- confess(blessed($instance)
+ $self->throw_error(blessed($instance)
. " does not support builder method '"
. $self->builder
. "' for attribute '"
. $self->name
- . "'");
+ . "'", object => $instance);
}
}
else {
return wantarray ? %{ $rv } : $rv;
}
else {
- confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
+ $self->throw_error("Can not auto de-reference the type constraint '" . $type_constraint->name . "'", object => $instance, data => $type_constraint);
}
}
my $name = "${class_name}::${handle}";
(!$associated_class->has_method($handle))
- || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
+ || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method => $handle);
# NOTE:
# handles is not allowed to delegate
# in the stack trace.
# - SL
$associated_class->add_method($handle => Class::MOP::subname($name, sub {
- my $proxy = (shift)->$accessor();
+ my $instance = shift;
+ my $proxy = $instance->$accessor();
(defined $proxy)
- || confess "Cannot delegate $handle to $method_to_call because " .
- "the value of " . $self->name . " is not defined";
+ || $self->throw_error("Cannot delegate $handle to $method_to_call because " .
+ "the value of " . $self->name . " is not defined", method => $method_to_call, object => $instance);
$proxy->$method_to_call(@_);
}));
}
}
elsif ($handle_type eq 'Regexp') {
($self->has_type_constraint)
- || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
+ || $self->throw_error("Cannot delegate methods based on a RegExpr without a type constraint (isa)", data => $handles);
return map { ($_ => $_) }
grep { /$handles/ } $self->_get_delegate_method_list;
}
return $handles->($self, $self->_find_delegate_metaclass);
}
else {
- confess "Unable to canonicalize the 'handles' option with $handles";
+ $self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles);
}
}
else {
my $role_meta = eval { $handles->meta };
if ($@) {
- confess "Unable to canonicalize the 'handles' option with $handles because : $@";
+ $self->throw_error("Unable to canonicalize the 'handles' option with $handles because : $@", data => $handles, error => $@);
}
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
- || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role";
+ || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role", data => $handles);
return map { $_ => $_ } (
$role_meta->get_method_list,
return $role->meta;
}
else {
- confess "Cannot find delegate metaclass for attribute " . $self->name;
+ $self->throw_error("Cannot find delegate metaclass for attribute " . $self->name);
}
}
return $meta->get_method_list;
}
else {
- confess "Unable to recognize the delegate metaclass '$meta'";
+ $self->throw_error("Unable to recognize the delegate metaclass '$meta'", data => $meta);
}
}
=over 4
+=item B<throw_error>
+
+Delegates to C<associated_class> or C<Moose::Meta::Class> if there is none.
+
=item B<interpolate_class_and_new>
=item B<interpolate_class>
projects / gitmo/Moose.git / blobdiff