use Scalar::Util 'blessed', 'weaken', 'reftype';
use Carp 'confess';
-our $VERSION = '0.06';
+our $VERSION = '0.08';
use Moose::Util::TypeConstraints ();
(defined $type_constraint)
|| confess "Could not find the type constraint '" . $options{isa} . "'";
}
+ # NOTE:
+ # check here to see if the new type
+ # is a subtype of the old one
($type_constraint->is_subtype_of($self->type_constraint->name))
|| confess "New type constraint setting must be a subtype of inherited one"
+ # iff we have a type constraint that is ...
if $self->has_type_constraint;
+ # then we use it :)
$actual_options{type_constraint} = $type_constraint;
delete $options{isa};
}
if (exists $options->{coerce} && $options->{coerce}) {
(exists $options->{type_constraint})
- || confess "You cannot have coercion without specifying a type constraint";
- (!$options->{type_constraint}->isa('Moose::Meta::TypeConstraint::Union'))
- || confess "You cannot have coercion with a type constraint union";
+ || confess "You cannot have coercion without specifying a type constraint";
confess "You cannot have a weak reference to a coerced value"
if $options->{weak_ref};
}
if (exists $options->{auto_deref} && $options->{auto_deref}) {
(exists $options->{type_constraint})
|| confess "You cannot auto-dereference without specifying a type constraint";
- ($options->{type_constraint}->name =~ /^ArrayRef|HashRef$/)
+ ($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";
}
if ($self->has_type_constraint) {
my $type_constraint = $self->type_constraint;
if ($self->should_coerce && $type_constraint->has_coercion) {
- $val = $type_constraint->coercion->coerce($val);
+ $val = $type_constraint->coerce($val);
}
(defined($type_constraint->check($val)))
|| confess "Attribute (" .
# FIXME - remove 'unless defined($value) - constraint Undef
return sprintf <<'EOF', $value, $value, $value, $value
-defined($attr->type_constraint->check(%s))
+defined($type_constraint->(%s))
|| confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
. $attr->type_constraint->name . ") with " . (defined(%s) ? "'%s'" : "undef")
if defined(%s);
sub _inline_check_coercion {
my $self = shift;
return '' unless $self->should_coerce;
- return 'my $val = $attr->type_constraint->coercion->coerce($_[1]);'
+ return 'my $val = $attr->type_constraint->coerce($_[1]);'
}
sub _inline_check_required {
sub _inline_check_lazy {
my $self = shift;
return '' unless $self->is_lazy;
+ if ($self->has_type_constraint) {
+ # NOTE:
+ # this could probably be cleaned
+ # up and streamlined a little more
+ return 'unless (exists $_[0]->{$attr_name}) {' .
+ ' if ($attr->has_default) {' .
+ ' my $default = $attr->default($_[0]);' .
+ ' (defined($type_constraint->($default)))' .
+ ' || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
+ ' . $attr->type_constraint->name . ") with " . (defined($default) ? "\'$default\'" : "undef")' .
+ ' if defined($default);' .
+ ' $_[0]->{$attr_name} = $default; ' .
+ ' }' .
+ ' else {' .
+ ' $_[0]->{$attr_name} = undef;' .
+ ' }' .
+ '}';
+ }
return '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)'
. 'unless exists $_[0]->{$attr_name};';
}
return $ref_value unless $self->should_auto_deref;
- my $type = $self->type_constraint->name;
+ my $type_constraint = $self->type_constraint;
my $sigil;
- if ($type eq "ArrayRef") {
+ if ($type_constraint->is_a_type_of('ArrayRef')) {
$sigil = '@';
}
- elsif ($type eq 'HashRef') {
+ elsif ($type_constraint->is_a_type_of('HashRef')) {
$sigil = '%';
}
else {
- confess "Can not auto de-reference the type constraint '$type'";
+ confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
}
"(wantarray() ? $sigil\{ ( $ref_value ) || return } : ( $ref_value ) )";
. $attr->_inline_check_lazy
. 'return ' . $attr->_inline_auto_deref($attr->_inline_get($inv))
. ' }';
+
+ # NOTE:
+ # set up the environment
+ my $type_constraint = $attr->type_constraint
+ ? $attr->type_constraint->_compiled_type_constraint
+ : undef;
+
my $sub = eval $code;
confess "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@;
return $sub;
. $attr->_inline_store($inv, $value_name)
. $attr->_inline_trigger($inv, $value_name)
. ' }';
+
+ # NOTE:
+ # set up the environment
+ my $type_constraint = $attr->type_constraint
+ ? $attr->type_constraint->_compiled_type_constraint
+ : undef;
+
my $sub = eval $code;
confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
return $sub;