use Moose::Util::TypeConstraints;
use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Meta::TypeConstraint::Structured::Optional;
use MooseX::Types::Structured::OverflowHandler;
use MooseX::Types -declare => [qw(Dict Tuple Optional)];
use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
=cut
+my $Optional = MooseX::Meta::TypeConstraint::Structured::Optional->new(
+ name => 'MooseX::Types::Structured::Optional',
+ package_defined_in => __PACKAGE__,
+ parent => find_type_constraint('Item'),
+ constraint => sub { 1 },
+ constraint_generator => sub {
+ my ($type_parameter, @args) = @_;
+ my $check = $type_parameter->_compiled_type_constraint();
+ return sub {
+ my (@args) = @_;
+ ## Does the arg exist? Something exists if it's a 'real' value
+ ## or if it is set to undef.
+ if(exists($args[0])) {
+ ## If it exists, we need to validate it
+ $check->($args[0]);
+ } else {
+ ## But it's is okay if the value doesn't exists
+ return 1;
+ }
+ }
+ }
+);
+
+Moose::Util::TypeConstraints::register_type_constraint($Optional);
+Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
MooseX::Meta::TypeConstraint::Structured->new(
name => "MooseX::Types::Structured::Tuple" ,
}
} else {
## Test if the TC supports null values
- unless($type_constraint->check()) {
+ unless ($type_constraint->is_subtype_of($Optional)) {
$_[2]->{message} = $type_constraint->get_message('NULL')
if ref $_[2];
return;
}
} else {
## Test to see if the TC supports null values
- unless($type_constraint->check()) {
+ unless ($type_constraint->is_subtype_of($Optional)) {
$_[2]->{message} = $type_constraint->get_message('NULL')
if ref $_[2];
return;
)
);
-OPTIONAL: {
- my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
- name => 'MooseX::Types::Structured::Optional',
- package_defined_in => __PACKAGE__,
- parent => find_type_constraint('Item'),
- constraint => sub { 1 },
- constraint_generator => sub {
- my ($type_parameter, @args) = @_;
- my $check = $type_parameter->_compiled_type_constraint();
- return sub {
- my (@args) = @_;
- ## Does the arg exist? Something exists if it's a 'real' value
- ## or if it is set to undef.
- if(exists($args[0])) {
- ## If it exists, we need to validate it
- $check->($args[0]);
- } else {
- ## But it's is okay if the value doesn't exists
- return 1;
- }
- }
- }
- );
-
- Moose::Util::TypeConstraints::register_type_constraint($Optional);
- Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
-}
-
sub slurpy ($) {
my ($tc) = @_;
return MooseX::Types::Structured::OverflowHandler->new(