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;