my ($class, $type, $full) = @_;
return sub {
my @args = @_;
- use Data::Dump qw/dump/; warn dump @args if @args;
+ #use Data::Dump qw/dump/; warn dump @args if @args;
my $type_constraint = find_type_constraint($full)
|| MooseX::Types::UndefinedType->new($full);
if(@args) {
my $tc = $args[0]->[0];
- warn dump $tc;
- $type_constraint->type_constraint($tc);
+ # warn dump $tc;
+ # $type_constraint->type_constraint($tc);
}
return MooseX::Types::TypeDecorator->new(type_constraint=>$type_constraint);
};
package MooseX::Types::TypeDecorator;
use Moose;
-use Moose::Util::TypeConstraints;
+use Moose::Util::TypeConstraints ();
use Moose::Meta::TypeConstraint ();
use overload(
'""' => sub {
shift->type_constraint->name;
},
+ '&' => sub {warn 'got code context'},
);
=head1 NAME
=cut
-class_type 'Moose::Meta::TypeConstraint';
+Moose::Util::TypeConstraints::class_type 'Moose::Meta::TypeConstraint';
=head2 MooseX::Types::UndefinedType
=cut
-class_type 'MooseX::Types::UndefinedType';
+Moose::Util::TypeConstraints::class_type 'MooseX::Types::UndefinedType';
=head1 ATTRIBUTES
is=>'ro',
isa=>'Moose::Meta::TypeConstraint|MooseX::Types::UndefinedType',
handles=>[
- Moose::Meta::TypeConstraint->meta->compute_all_applicable_methods,
- "_compiled_type_constraint",
+ grep {
+ $_ ne 'meta' && $_ ne '(""';
+ } map {
+ $_->{name};
+ } Moose::Meta::TypeConstraint->meta->compute_all_applicable_methods,
],
);
use warnings;
use strict;
-use Test::More tests => 1;
+use Test::More tests => 10;
use FindBin;
use lib "$FindBin::Bin/lib";
-use DecoratorLibrary qw( ArrayOfInts);
-is 1,1, 'ok';
+{
+ package Test::MooseX::TypeLibrary::TypeDecorator;
+
+ use Moose;
+ use DecoratorLibrary qw(
+ MyArrayRefBase
+ MyArrayRefInt01
+ MyArrayRefInt02
+ );
+
+ has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
+ has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
+}
-use Data::Dump qw/dump/;
+## Make sure we have a 'create object sanity check'
+
+ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(),
+ => 'Created some sort of object';
+
+isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
+ => "Yes, it's the correct kind of object";
+
+## test arrayrefbase normal and coercion
+
+ok $type->arrayrefbase([qw(a b c)])
+ => 'Assigned arrayrefbase qw(a b c)';
+
+is_deeply $type->arrayrefbase, [qw(a b c)],
+ => 'Assigment is correct';
+
+ok $type->arrayrefbase('d,e,f')
+ => 'Assigned arrayrefbase d,e,f to test coercion';
+
+is_deeply $type->arrayrefbase, [qw(d e f)],
+ => 'Assigment and coercion is correct';
+
+## test arrayrefint01 normal and coercion
+
+ok $type->arrayrefint01([qw(a b c)])
+ => 'Assigned arrayrefbase qw(a b c)';
+
+is_deeply $type->arrayrefint01, [qw(a b c)],
+ => 'Assigment is correct';
+
+ok $type->arrayrefint01('d.e.f')
+ => 'Assigned arrayrefbase d,e,f to test coercion';
+
+is_deeply $type->arrayrefint01, [qw(d e f)],
+ => 'Assigment and coercion is correct';
+
+#use Data::Dump qw/dump/;
+#warn dump MyArrayRefInt01;
+#warn dump MyArrayRefBase->validate('aaa,bbb,ccc');
--- /dev/null
+package DecoratorLibrary;
+
+use warnings;
+use strict;
+
+use MooseX::Types::Moose qw( Str ArrayRef HashRef Int );
+use MooseX::Types
+ -declare => [qw(
+ MyArrayRefBase
+ MyArrayRefInt01
+ MyArrayRefInt02
+ )];
+
+subtype MyArrayRefBase,
+ as ArrayRef;
+
+coerce MyArrayRefBase,
+ from Str,
+ via {[split(',', $_)]};
+
+subtype MyArrayRefInt01,
+ as ArrayRef[Int];
+
+coerce MyArrayRefInt01,
+ from Str,
+ via {[split('\.',$_)]},
+ from HashRef,
+ via {[values(%$_)]};
+
+subtype MyArrayRefInt02,
+ as MyArrayRefBase[Int];
+
+coerce MyArrayRefInt02,
+ from Str,
+ via {[split(':',$_)]};
+ from HashRef[Int],
+ via {[values(%$_)]},
+ from HashRef[Str],
+ via {[ map { length $_ } values(%_) ]};
+1;