my $predicate = sub{ Scalar::Util::blessed($_[0]) && $_[0]->isa($for_class) };
if(defined $name){
- no strict 'refs';
- *{ caller() . '::' . $name } = $predicate;
+ Mouse::Util::install_subroutines(scalar caller, $name => $predicate);
return;
}
};
if(defined $name){
- no strict 'refs';
- *{ caller() . '::' . $name } = $predicate;
+ Mouse::Util::install_subroutines(scalar caller, $name => $predicate);
return;
}
sub Undef { !defined($_[0]) }
sub Defined { defined($_[0]) }
sub Value { defined($_[0]) && !ref($_[0]) }
-sub Num { !ref($_[0]) && looks_like_number($_[0]) }
-sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
+sub Num { looks_like_number($_[0]) }
+sub Int {
+ my($value) = @_;
+ looks_like_number($value) && $value =~ /\A [+-]? [0-9]+ \z/xms;
+}
sub Str {
my($value) = @_;
return defined($value) && ref(\$value) eq 'SCALAR';
$self->{methods}->{$name} = $code; # Moose stores meta object here.
- my $pkg = $self->name;
- no strict 'refs';
- no warnings 'redefine', 'once';
- *{ $pkg . '::' . $name } = $code;
+ Mouse::Util::install_subroutines($self->name,
+ $name => $code,
+ );
return;
}
package Mouse::Meta::Class;
+use Mouse::Meta::Method::Constructor;
+use Mouse::Meta::Method::Destructor;
+
sub method_metaclass { $_[0]->{method_metaclass} || 'Mouse::Meta::Method' }
sub attribute_metaclass { $_[0]->{attribute_metaclass} || 'Mouse::Meta::Attribute' }
}
sub _initialize_object{
- my($self, $object, $args, $ignore_triggers) = @_;
+ my($self, $object, $args, $is_cloning) = @_;
my @triggers_queue;
}
else { # no init arg
if ($attribute->has_default || $attribute->has_builder) {
- if (!$attribute->is_lazy) {
+ if (!$attribute->is_lazy && !exists $object->{$slot}) {
my $default = $attribute->default;
my $builder = $attribute->builder;
my $value = $builder ? $object->$builder()
if ref($object->{$slot}) && $attribute->is_weak_ref;
}
}
- elsif($attribute->is_required) {
+ elsif(!$is_cloning && $attribute->is_required) {
$self->throw_error("Attribute (".$attribute->name.") is required");
}
}
}
- if(!$ignore_triggers){
+ if(@triggers_queue){
foreach my $trigger_and_value(@triggers_queue){
my($trigger, $value) = @{$trigger_and_value};
$trigger->($object, $value);
return;
}
+sub check {
+ my $self = shift;
+ return $self->_compiled_type_constraint->(@_);
+}
+
+
package Mouse::Object;
sub BUILDARGS {
=head1 VERSION
-This document describes Mouse version 0.50_03
+This document describes Mouse version 0.59
=head1 SEE ALSO