}';
my $sub = eval $accessor;
- Carp::confess($@) if $@;
+ $attribute->throw_error($@) if $@;
return $sub;
}
my $predicate = 'sub { exists($_[0]->{'.$key.'}) }';
my $sub = eval $predicate;
- confess $@ if $@;
+ $attribute->throw_error($@) if $@;
return $sub;
}
my $clearer = 'sub { delete($_[0]->{'.$key.'}) }';
my $sub = eval $clearer;
- confess $@ if $@;
+ $attribute->throw_error($@) if $@;
return $sub;
}
}';
$method_map{$local_method} = eval $method;
- confess $@ if $@;
+ $attribute->throw_error($@) if $@;
}
return \%method_map;
my $name = shift;
my $args = shift;
- confess "You can not use lazy_build and default for the same attribute ($name)"
+ $self->throw_error("You can not use lazy_build and default for the same attribute ($name)")
if $args->{lazy_build} && exists $args->{default};
- confess "You cannot have lazy attribute ($name) without specifying a default value for it"
+ $self->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it")
if $args->{lazy}
&& !exists($args->{default})
&& !exists($args->{builder});
- confess "References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])"
+ $self->throw_error("References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
if ref($args->{default})
&& ref($args->{default}) ne 'CODE';
- confess "You cannot auto-dereference without specifying a type constraint on attribute ($name)"
+ $self->throw_error("You cannot auto-dereference without specifying a type constraint on attribute ($name)")
if $args->{auto_deref} && !exists($args->{isa});
- confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)"
+ $self->throw_error("You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)")
if $args->{auto_deref}
&& $args->{isa} !~ /^(?:ArrayRef|HashRef)(?:\[.*\])?$/;
if ($args->{trigger}) {
if (ref($args->{trigger}) eq 'HASH') {
- Carp::carp "HASH-based form of trigger has been removed. Only the coderef form of triggers are now supported.";
+ $self->throw_error("HASH-based form of trigger has been removed. Only the coderef form of triggers are now supported.");
}
- confess "Trigger must be a CODE ref on attribute ($name)"
+ $self->throw_error("Trigger must be a CODE ref on attribute ($name)")
if ref($args->{trigger}) ne 'CODE';
}
sub verify_type_constraint_error {
my($self, $name, $value, $type) = @_;
- Carp::confess("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value));
+ $self->throw_error("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value));
}
sub coerce_constraint { ## my($self, $value) = @_;
return map { $_ => $_ } @$handles;
}
else {
- confess "Unable to canonicalize the 'handles' option with $handles";
+ $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
}
}
return %{ $super_attr->_create_args };
}
- confess "Could not find an attribute by the name of '$name' to inherit from";
+ $self->throw_error("Could not find an attribute by the name of '$name' to inherit from");
+}
+
+sub throw_error{
+ my $self = shift;
+
+ my $metaclass = (ref $self && $self->associated_class) || 'Mouse::Meta::Class';
+ $metaclass->throw_error(@_, depth => 1);
}
1;
use Mouse::Meta::Method::Constructor;
use Mouse::Meta::Method::Destructor;
use Scalar::Util qw/blessed weaken/;
-use Mouse::Util qw/get_linear_isa/;
-use Carp 'confess';
+use Mouse::Util qw/get_linear_isa not_supported/;
use base qw(Mouse::Meta::Module);
my $self = shift;
my $args = (@_ == 1) ? $_[0] : { @_ };
- foreach my $attribute ($self->meta->get_all_attributes) {
+ my $instance = bless {}, $self->name;
+
+ foreach my $attribute ($self->get_all_attributes) {
my $from = $attribute->init_arg;
my $key = $attribute->name;
$instance->{$key} = $args->{$from};
weaken($instance->{$key})
- if $attribute->is_weak_ref;
+ if ref($instance->{$key}) && $attribute->is_weak_ref;
if ($attribute->has_trigger) {
$attribute->trigger->($instance, $args->{$from});
$instance->{$key} = $value;
weaken($instance->{$key})
- if $attribute->is_weak_ref;
+ if ref($instance->{$key}) && $attribute->is_weak_ref;
}
}
else {
if ($attribute->is_required) {
- confess "Attribute (".$attribute->name.") is required";
+ $self->throw_error("Attribute (".$attribute->name.") is required");
}
}
}
my $instance = shift;
(blessed($instance) && $instance->isa($class->name))
- || confess "You must pass an instance of the metaclass (" . $class->name . "), not ($instance)";
+ || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($instance)");
$class->clone_instance($instance, @_);
}
my ($class, $instance, %params) = @_;
(blessed($instance))
- || confess "You can only clone instances, ($instance) is not a blessed instance";
+ || $class->throw_error("You can only clone instances, ($instance) is not a blessed instance");
my $clone = bless { %$instance }, ref $instance;
@_,
);
- my $name = $self->name;
$self->{is_immutable}++;
if ($args{inline_constructor}) {
return 1;
}
-sub make_mutable { confess "Mouse does not currently support 'make_mutable'" }
+sub make_mutable { not_supported }
sub is_immutable { $_[0]->{is_immutable} }
# Class::Method::Modifiers won't do this for us, so do it ourselves
my $body = $pkg->can($name)
- or confess "You cannot override '$method' because it has no super method";
+ or $self->throw_error("You cannot override '$method' because it has no super method");
no strict 'refs';
*$method = sub { $code->($pkg, $body, @_) };
my ($self, $role_name) = @_;
(defined $role_name)
- || confess "You must supply a role name to look for";
+ || $self->throw_error("You must supply a role name to look for");
for my $class ($self->linearized_isa) {
my $meta = Mouse::class_of($class);
my ($class, $package_name, %options) = @_;
(ref $options{superclasses} eq 'ARRAY')
- || confess "You must pass an ARRAY ref of superclasses"
+ || $class->throw_error("You must pass an ARRAY ref of superclasses")
if exists $options{superclasses};
(ref $options{attributes} eq 'ARRAY')
- || confess "You must pass an ARRAY ref of attributes"
+ || $class->throw_error("You must pass an ARRAY ref of attributes")
if exists $options{attributes};
(ref $options{methods} eq 'HASH')
- || confess "You must pass a HASH ref of methods"
+ || $class->throw_error("You must pass a HASH ref of methods")
if exists $options{methods};
do {
( defined $package_name && $package_name )
- || confess "You must pass a package name";
+ || $class->throw_error("You must pass a package name");
my $code = "package $package_name;";
$code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
if exists $options{authority};
eval $code;
- confess "creation of $package_name failed : $@" if $@;
+ $class->throw_error("creation of $package_name failed : $@") if $@;
};
my %initialize_options = %options;
use strict;
use warnings;
-use Mouse::Util qw/get_code_info/;
+use Mouse::Util qw/get_code_info not_supported/;
use Scalar::Util qw/blessed/;
-use Carp ();
+
{
my %METACLASS_CACHE;
my($class, $package_name, @args) = @_;
($package_name && !ref($package_name))\r
- || confess("You must pass a package name and it cannot be blessed");\r
+ || $class->throw_error("You must pass a package name and it cannot be blessed");\r
return $METACLASS_CACHE{$package_name}
||= $class->_new(package => $package_name, @args);
}
+sub meta{ Mouse::Meta::Class->initialize(ref $_[0] || $_[0]) }
+
sub _new{ Carp::croak("Mouse::Meta::Module is an abstract class") }
sub name { $_[0]->{package} }
my($self, $name, $code) = @_;
if(!defined $name){
- confess "You must pass a defined name";
+ $self->throw_error("You must pass a defined name");
}
if(ref($code) ne 'CODE'){
- confess "You must pass a CODE reference";
+ not_supported 'add_method for a method object';
}
$self->_method_map->{$name}++; # Moose stores meta object here.
sub throw_error{
my($class, $message, %args) = @_;
- local $Carp::CarpLevel = $Carp::CarpLevel + ($args{depth} || 1);
+ local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though\r
if(exists $args{longmess} && !$args{longmess}){ # intentionaly longmess => 0
package Mouse::Meta::Role;
use strict;
use warnings;
-use Carp 'confess';
+use Mouse::Util qw(not_supported);
use base qw(Mouse::Meta::Module);
sub _new {
}
}
- confess "'$role_name' requires the method '$method_name' to be implemented by '$class_name'"
+ $role->throw_error("'$role_name' requires the method '$method_name' to be implemented by '$class_name'")
unless $has_method;
}
}
my($self, $class, %args) = @_;
if ($class->isa('Mouse::Object')) {
- Carp::croak('Mouse does not support Application::ToInstance yet');
+ not_supported 'Application::ToInstance';
}
$self->_check_required_methods($class, \%args);
my ($self, $role_name) = @_;
(defined $role_name)
- || confess "You must supply a role name to look for";
+ || $self->throw_error("You must supply a role name to look for");
# if we are it,.. then return true
return 1 if $role_name eq $self->name;
use strict;
use warnings;
-use Carp 'confess';
-
sub new {
my $class = shift;
- confess('Cannot call new() on an instance') if ref $class;
+ $class->throw_error('Cannot call new() on an instance') if ref $class;
my $args = $class->BUILDARGS(@_);
- my $instance = Mouse::Meta::Class->initialize($class)->new_object($params);
+ my $instance = Mouse::Meta::Class->initialize($class)->new_object($args);
$instance->BUILDALL($args);
return $instance;
}
if (scalar @_ == 1) {
(ref($_[0]) eq 'HASH')
- || confess "Single parameters to new() must be a HASH ref";
+ || $class->meta->throw_error("Single parameters to new() must be a HASH ref");
return {%{$_[0]}};
}
else {
sub does {
my ($self, $role_name) = @_;
(defined $role_name)
- || confess "You must supply a role name to does()";
+ || $self->meta->throw_error("You must supply a role name to does()");
return $self->meta->does_role($role_name);
};
get_linear_isa
apply_all_roles
get_code_info
+ not_supported
);
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
return;
}
+sub not_supported{
+ my($feature) = @_;
+
+ $feature ||= ( caller(1) )[3]; # subroutine name
+
+ local $Carp::CarpLevel = $Carp::CarpLevel + 2;
+ Carp::croak("Mouse does not currently support $feature");
+}
+
1;
__END__
projects / gitmo/Mouse.git / commitdiff