fatal = 1
[NoTabsTests]
+[EOLTests]
[MetaTests]
[Test::ChangesHasContent]
[Test::Version]
=head1 LIBRARY DEFINITION
-A MooseX::Types is just a normal Perl module. Unlike Moose
+A MooseX::Types is just a normal Perl module. Unlike Moose
itself, it does not install C<use strict> and C<use warnings> in your
class by default, so this is up to you.
with C<@types> being a list of types you wish to define in this library.
This line will install a proper base class in your package as well as the
-full set of L<handlers|/"TYPE HANDLER FUNCTIONS"> for your declared
+full set of L<handlers|/"TYPE HANDLER FUNCTIONS"> for your declared
types. It will then hand control over to L<Moose::Util::TypeConstraints>'
C<import> method to export the functions you will need to declare your
types.
-If you want to use Moose' built-in types (e.g. for subtyping) you will
-want to
+If you want to use Moose' built-in types (e.g. for subtyping) you will
+want to
use MooseX::Types::Moose @types;
You will have to define coercions for your types or your library won't
export a L</to_$type> coercion helper for it.
-Note that you currently cannot define types containing C<::>, since
+Note that you currently cannot define types containing C<::>, since
exporting would be a problem.
You also don't need to use C<warnings> and C<strict>, since the
sub type_export_generator {
my ($class, $type, $name) = @_;
-
+
## Return an anonymous subroutine that will generate the proxied type
## constraint for you.
$type_constraint = defined($type_constraint) ? $type_constraint
: MooseX::Types::UndefinedType->new($name);
-
+
my $type_decorator = $class->create_type_decorator($type_constraint);
-
+
## If there are additional args, that means it's probably stuff that
## needs to be returned to the subtype. Not an ideal solution here but
## doesn't seem to cause trouble.
-
+
if(@_) {
return ($type_decorator, @_);
} else {
=cut
sub create_arged_type_constraint {
- my ($class, $name, @args) = @_;
+ my ($class, $name, @args) = @_;
my $type_constraint = Moose::Util::TypeConstraints::find_or_create_type_constraint("$name");
my $parameterized = $type_constraint->parameterize(@args);
# It's obnoxious to have to parameterize before looking for the TC, but the
=head1 DESCRIPTION
You normally won't need to interact with this class by yourself. It is
-merely a collection of functionality that type libraries need to
+merely a collection of functionality that type libraries need to
interact with moose and the rest of the L<MooseX::Types> module.
=cut
=head2 import
-Provides the import mechanism for your library. See
+Provides the import mechanism for your library. See
L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
=cut
# determine the wrapper, -into is supported for compatibility reasons
my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
- $args[0]->{into} = $options->{ -into }
+ $args[0]->{into} = $options->{ -into }
if exists $options->{ -into };
my (%ex_spec, %ex_util);
my $undef_msg = sprintf($UndefMsg, $type_short, $class);
# the type itself
- push @{ $ex_spec{exports} },
+ push @{ $ex_spec{exports} },
$type_short,
- sub {
+ sub {
bless $wrapper->type_export_generator($type_short, $type_full),
'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
};
# create S:E exporter and increase export level unless specified explicitly
my $exporter = build_exporter \%ex_spec;
- $options->{into_level}++
+ $options->{into_level}++
unless $options->{into};
# remember requested symbols to determine what helpers to auto-export
- my %was_requested =
- map { ($_ => 1) }
- grep { not ref }
+ my %was_requested =
+ map { ($_ => 1) }
+ grep { not ref }
@args;
# determine which additional symbols (helpers) to export along
=head1 DESCRIPTION
-Allows you to export types from multiple type libraries.
+Allows you to export types from multiple type libraries.
Libraries on the right side of the type libs passed to L</provide_types_from>
take precedence over those on the left in case of conflicts.
=cut
# all available builtin types as short and long name
-my %BuiltIn_Storage
- = map { ($_) x 2 }
+my %BuiltIn_Storage
+ = map { ($_) x 2 }
Moose::Util::TypeConstraints->list_all_builtin_type_constraints;
=head1 METHODS
=head1 SEE ALSO
L<MooseX::Types::Moose>,
-L<Moose>,
+L<Moose>,
L<Moose::Util::TypeConstraints>
=head1 LICENSE
'""' => sub {
my $self = shift @_;
if(blessed $self) {
- return $self->__type_constraint->name;
+ return $self->__type_constraint->name;
} else {
return "$self";
}
},
bool => sub { 1 },
'|' => sub {
-
+
## It's kind of ugly that we need to know about Union Types, but this
## is needed for syntax compatibility. Maybe someday we'll all just do
## Or[Str,Str,Int]
return Moose::Util::TypeConstraints::register_type_constraint($union);
},
fallback => 1,
-
+
);
=head1 DESCRIPTION
return bless {'__type_constraint'=>$arg}, $class;
} elsif(
blessed $arg &&
- $arg->isa('MooseX::Types::UndefinedType')
+ $arg->isa('MooseX::Types::UndefinedType')
) {
## stub in case we'll need to handle these types differently
return bless {'__type_constraint'=>$arg}, $class;
__PACKAGE__->_throw_error("Argument cannot be '$arg'");
}
} else {
- __PACKAGE__->_throw_error("This method [new] requires a single argument.");
+ __PACKAGE__->_throw_error("This method [new] requires a single argument.");
}
}
=cut
sub __type_constraint {
- my $self = shift @_;
+ my $self = shift @_;
if(blessed $self) {
if(defined(my $tc = shift @_)) {
$self->{__type_constraint} = $tc;
}
- return $self->{__type_constraint};
+ return $self->{__type_constraint};
} else {
__PACKAGE__->_throw_error('cannot call __type_constraint as a class method');
}
sub AUTOLOAD {
my ($self, @args) = @_;
my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
-
+
## We delegate with this method in an attempt to support a value of
## __type_constraint which is also AUTOLOADing, in particular the class
## MooseX::Types::UndefinedType which AUTOLOADs during autovivication.
- $self->_try_delegate($method, @args);
+ $self->_try_delegate($method, @args);
}
sub _try_delegate {
last unless $search_tc && $search_tc->is_subtype_of('Object');
}
}
-
+
my $inv = do {
if ($method eq 'new') {
die "new called on type decorator for non-class-type ".$tc->name
=head1 DESCRIPTION
-Whenever a type handle function (e.g. C<Int()> can't find a type
+Whenever a type handle function (e.g. C<Int()> can't find a type
constraint under it's full name, it assumes it has not yet been defined.
-It will then return an instance of this class, handling only
+It will then return an instance of this class, handling only
stringification, name and possible identification of undefined types.
Later, when you try to use the Undefined Type Constraint, autovivification will
sub AUTOLOAD {
my ($self, @args) = @_;
- my ($method) = our $AUTOLOAD =~ /([^:]+)$/;
+ my ($method) = our $AUTOLOAD =~ /([^:]+)$/;
if(my $type_constraint = $self->__autovivify) {
return $type_constraint->$method(@args);
=head1 SEE ALSO
L<MooseX::Types::Moose>,
-L<Moose::Util::TypeConstraints>,
+L<Moose::Util::TypeConstraints>,
L<Moose::Meta::TypeConstraint>,
L<Carp::Clan>
=head1 DESCRIPTION
-This package the exportable functions that many parts in
+This package the exportable functions that many parts in
L<MooseX::Types> might need.
=cut
TypeConstraint | Undef = has_available_type_export($package, $name);
-This function allows you to introspect if a given type export is available
+This function allows you to introspect if a given type export is available
I<at this point in time>. This means that the C<$package> must have imported
a typeconstraint with the name C<$name>, and it must be still in its symbol
table.
croak qq($class expects an array reference as import spec)
unless ref $libraries{ $l } eq 'ARRAY';
- my $library_class
+ my $library_class
= ($l eq 'Moose' ? 'MooseX::Types::Moose' : $l );
Class::MOP::load_class($library_class);
- $library_class->import({
+ $library_class->import({
-into => scalar(caller),
-wrapper => $class,
}, @{ $libraries{ $l } });
}
# coercion handler export
- {
+ {
my ($coerce, $coercion_result, $cannot_coerce) = map { shift @$data } 1 .. 3;
ok my $code = __PACKAGE__->can("to_$type"), "to_$type() coercion was exported";
is_deeply scalar $code->($coerce), $coercion_result, "to_$type() coercion works";
}
# coercion handler export
- {
+ {
my ($coerce, $coercion_result, $cannot_coerce) = map { shift @$data } 1 .. 3;
ok my $code = __PACKAGE__->can("to_$type"), "to_$type() coercion was exported";
is_deeply scalar $code->($coerce), $coercion_result, "to_$type() coercion works";
{
package Test::MooseX::TypeLibrary::TypeDecorator;
-
+
use Moose;
use MooseX::Types::Moose qw(
Int Str ArrayRef HashRef Object
AtLeastOneInt Jobs SubOfMyArrayRefInt01 WierdIntegersArrayRef1
WierdIntegersArrayRef2
);
-
+
has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1);
has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]);
has 'StrOrArrayRef_attr' => (is=>'rw', isa=>StrOrArrayRef);
has 'AtLeastOneInt_attr' => (is=>'rw', isa=>AtLeastOneInt);
- has 'pipeoverloading' => (is=>'rw', isa=>Int|Str);
+ has 'pipeoverloading' => (is=>'rw', isa=>Int|Str);
has 'deep' => (is=>'rw', isa=>ArrayRef[ArrayRef[HashRef[Int]]] );
has 'deep2' => (is=>'rw', isa=>ArrayRef[Int|ArrayRef[HashRef[Int|Object]]] );
has 'enum' => (is=>'rw', isa=>Jobs);
has 'SubOfMyArrayRefInt01_attr' => (is=>'rw', isa=>SubOfMyArrayRefInt01);
has 'WierdIntegersArrayRef1_attr' => (is=>'rw', isa=>WierdIntegersArrayRef1);
- has 'WierdIntegersArrayRef2_attr' => (is=>'rw', isa=>WierdIntegersArrayRef2);
+ has 'WierdIntegersArrayRef2_attr' => (is=>'rw', isa=>WierdIntegersArrayRef2);
}
## 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";
ok $type->arrayrefbase([qw(a b c d e)])
=> 'Assigned arrayrefbase qw(a b c d e)';
-
+
is_deeply $type->arrayrefbase, [qw(a b c d e)],
=> 'Assignment is correct';
ok $type->arrayrefbase('d,e,f')
=> 'Assignment arrayrefbase d,e,f to test coercion';
-
+
is_deeply $type->arrayrefbase, [qw(d e f)],
=> 'Assignment and coercion is correct';
ok $type->arrayrefint01([qw(1 2 3)])
=> 'Assignment arrayrefint01 qw(1 2 3)';
-
+
is_deeply $type->arrayrefint01, [qw(1 2 3)],
=> 'Assignment is correct';
ok $type->arrayrefint01('4.5.6')
=> 'Assigned arrayrefint01 4.5.6 to test coercion from Str';
-
+
is_deeply $type->arrayrefint01, [qw(4 5 6)],
=> 'Assignment and coercion is correct';
ok $type->arrayrefint01({a=>7,b=>8})
=> 'Assigned arrayrefint01 {a=>7,b=>8} to test coercion from HashRef';
-
+
is_deeply $type->arrayrefint01, [qw(7 8)],
=> 'Assignment and coercion is correct';
-
+
like exception {
$type->arrayrefint01([qw(a b c)])
}, qr/Attribute \(arrayrefint01\) does not pass the type constraint/ => 'Dies when values are strings';
ok $type->arrayrefint02([qw(1 2 3)])
=> 'Assigned arrayrefint02 qw(1 2 3)';
-
+
is_deeply $type->arrayrefint02, [qw(1 2 3)],
=> 'Assignment is correct';
ok $type->arrayrefint02('4:5:6')
=> 'Assigned arrayrefint02 4:5:6 to test coercion from Str';
-
+
is_deeply $type->arrayrefint02, [qw(4 5 6)],
=> 'Assignment and coercion is correct';
ok $type->arrayrefint02({a=>7,b=>8})
=> 'Assigned arrayrefint02 {a=>7,b=>8} to test coercion from HashRef';
-
+
is_deeply $type->arrayrefint02, [qw(7 8)],
=> 'Assignment and coercion is correct';
-
+
ok $type->arrayrefint02({a=>'AA',b=>'BBB', c=>'CCCCCCC'})
=> "Assigned arrayrefint02 {a=>'AA',b=>'BBB', c=>'CCCCCCC'} to test coercion from HashRef";
-
+
is_deeply $type->arrayrefint02, [qw(2 3 7)],
=> 'Assignment and coercion is correct';
ok $type->arrayrefint02({a=>[1,2],b=>[3,4]})
=> "Assigned arrayrefint02 {a=>[1,2],b=>[3,4]} to test coercion from HashRef";
-
+
is_deeply $type->arrayrefint02, [qw(1 2 3 4)],
=> 'Assignment and coercion is correct';
-
-# test arrayrefint03
+
+# test arrayrefint03
ok $type->arrayrefint03([qw(11 12 13)])
=> 'Assigned arrayrefint01 qw(11 12 13)';
-
+
is_deeply $type->arrayrefint03, [qw(11 12 13)],
=> 'Assignment is correct';
-
+
like exception {
$type->arrayrefint03([qw(a b c)])
}, qr/Attribute \(arrayrefint03\) does not pass the type constraint/ => 'Dies when values are strings';
ok $type->StrOrArrayRef_attr([1,2,3])
=> 'arrayref part of union is good';
-
+
like exception {
$type->StrOrArrayRef_attr({a=>111});
}, qr/Attribute \(StrOrArrayRef_attr\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
is_deeply $type->AtLeastOneInt_attr, [1,2]
=> "Got expected values.";
-
+
like exception {
$type->AtLeastOneInt_attr([]);
}, qr/Attribute \(AtLeastOneInt_attr\) does not pass the type constraint/ => 'properly fails to assign as []';
ok $type->pipeoverloading(1)
=> 'Integer for union test accepted';
-
+
ok $type->pipeoverloading('a')
=> 'String for union test accepted';
is_deeply $type->deep, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]],
=> 'Assignment is correct';
-
+
like exception {
$type->deep({a=>1,b=>2});
}, qr/Attribute \(deep\) does not pass the type constraint/ => 'Deep Constraints properly fail';
is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]],
=> 'Assignment is correct';
-
+
like exception {
$type->deep2({a=>1,b=>2});
}, qr/Attribute \(deep2\) does not pass the type constraint/ => 'Deep Constraints properly fail';
is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]],
=> 'Assignment is correct';
-
+
ok $type->deep2([1,2,3])
=> 'Assigned deep2 to [1,2,3]';
is_deeply $type->deep2, [1,2,3],
=> 'Assignment is correct';
-
+
## Test jobs
ok $type->enum('Programming')
is_deeply $type->SubOfMyArrayRefInt01_attr, [15,20,25],
=> 'Assignment is correct';
-
+
like exception {
$type->SubOfMyArrayRefInt01_attr([15,5,20]);
}, qr/Attribute \(SubOfMyArrayRefInt01_attr\) does not pass the type constraint/
=> 'SubOfMyArrayRefInt01 Constraints properly fail';
-## test WierdIntegersArrayRef1
+## test WierdIntegersArrayRef1
ok $type->WierdIntegersArrayRef1_attr([5,10,1000])
=> 'Assigned deep2 to [5,10,1000]';
is_deeply $type->WierdIntegersArrayRef1_attr, [5,10,1000],
=> 'Assignment is correct';
-
+
like exception {
$type->WierdIntegersArrayRef1_attr({a=>1,b=>2});
}, qr/Attribute \(WierdIntegersArrayRef1_attr\) does not pass the type constraint/
}, qr/Attribute \(WierdIntegersArrayRef1_attr\) does not pass the type constraint/
=> 'Constraints properly fail';
-## test WierdIntegersArrayRef2
+## test WierdIntegersArrayRef2
ok $type->WierdIntegersArrayRef2_attr([5,10,$type])
=> 'Assigned deep2 to [5,10,$type]';
is_deeply $type->WierdIntegersArrayRef2_attr, [5,10,$type],
=> 'Assignment is correct';
-
+
like exception {
$type->WierdIntegersArrayRef2_attr({a=>1,b=>2});
}, qr/Attribute \(WierdIntegersArrayRef2_attr\) does not pass the type constraint/
use warnings;
use Test::More;
use FindBin;
- use lib "$FindBin::Bin/lib";
-
+ use lib "$FindBin::Bin/lib";
+
use Test::Requires { 'Sub::Exporter' => '0' };
}
use SubExporterCompatibility qw(MyStr something);
-
+
ok MyStr->check('aaa'), "Correctly passed";
ok !MyStr->check([1]), "Correctly fails";
ok something(), "Found the something method";
BEGIN {
package MooseX::Types::Test::Recursion;
-
+
use Moose;
use Moose::Util::TypeConstraints;
{
package MooseX::Types::Test::Recursion::TestRunner;
-
+
BEGIN {
use Test::More;
-
+
## Grab the newly created test type constraint
MooseX::Types::Test::Recursion->import(':all');
};
-
+
ok RecursiveHashRef->check({key=>"value"})
=> 'properly validated {key=>"value"}';
-
+
ok RecursiveHashRef->check({key=>{subkey=>"value"}})
=> 'properly validated {key=>{subkey=>"value"}}';
-
+
ok RecursiveHashRef->check({
key=>{
subkey=>"value",
}
}
}) => 'properly validated deeper recursive values';
-
+
ok ! RecursiveHashRef->check({key=>[1,2,3]})
=> 'Properly invalidates bad value';
-
+
ok ! RecursiveHashRef->check({key=>{subkey=>"value",subkey2=>{ssubkey=>[1,2,3]}}})
=> 'Properly invalidates bad value deeply';
::ok(!$@, "introspecting something that's not not a type doesn't blow up");
}
- BEGIN {
- no strict 'refs';
+ BEGIN {
+ no strict 'refs';
delete ${'IntrospectionTest::'}{TwentyThree};
}
};
#!/usr/bin/env perl
use strict;
use warnings;
-
+
use Test::More;
{
Test::More::ok !$@, 'types are not mutated by union with a string type';
- subtype Test1,
+ subtype Test1,
as Int | 'ArrayRef[Int]';
-
+
Test::More::ok Test1->check(1), '1 is an Int';
Test::More::ok !Test1->check('a'), 'a is not an Int';
Test::More::ok Test1->check([1, 2, 3]), 'Passes ArrayRef';
Test::More::ok !Test1->check({a=>1}), 'fails wrong ref type';
eval {
- subtype Test2,
+ subtype Test2,
as Int | 'IDONTEXIST';
};
my $check = $@;
- Test::More::ok $@, 'Got an error for bad Type';
+ Test::More::ok $@, 'Got an error for bad Type';
Test::More::like $check, qr/IDONTEXIST is not a type constraint/, 'correct error';
- my $obj = subtype Test3,
+ my $obj = subtype Test3,
as Int | 'ArrayRef[Int]' | Object;
Test::More::ok Test3->check(1), '1 is an Int';
subtype MyArrayRefBase,
as ArrayRef;
-
+
coerce MyArrayRefBase,
from Str,
via {[split(',', $_)]};
-
+
subtype MyArrayRefInt01,
as ArrayRef[Int];
subtype BiggerInt,
as Int,
where {$_>10};
-
+
subtype SubOfMyArrayRefInt01,
as MyArrayRefInt01[BiggerInt];
via {[split('\.',$_)]},
from HashRef,
via {[sort values(%$_)]};
-
+
subtype MyArrayRefInt02,
as MyArrayRefBase[Int];
-
+
subtype MyHashRefOfInts,
as HashRef[Int];
-
+
subtype MyHashRefOfStr,
as HashRef[Str];
subtype AtLeastOneInt,
as ArrayRef[Int],
where { @$_ > 0 };
-
+
enum Jobs,
(qw/Programming Teaching Banking/);
-
+
subtype isFive,
as Int,
where { $_ == 5};
subtype isTen,
as Int,
where { $_ == 10};
-
+
subtype isFifteen,
as Int,
where { $_ == 15};
-
+
subtype VeryBigInt,
as BiggerInt,
where {$_>100};
-
+
subtype FiveOrTenOrFifteen,
as isFive|isTen|isFifteen;
as ArrayRef[FiveOrTenOrFifteen|VeryBigInt];
subtype WierdIntegersArrayRef2,
- as ArrayRef[FiveOrTenOrFifteen|Object];
+ as ArrayRef[FiveOrTenOrFifteen|Object];
1;
package SubExporterCompatibility; {
-
+
use MooseX::Types::Moose qw(Str);
use MooseX::Types -declare => [qw(MyStr)];
use Sub::Exporter -setup => { exports => [ qw(something MyStr) ] };
-
+
subtype MyStr,
as Str;
-
+
sub something {
return 1;
- }
-
+ }
+
} 1;
projects / gitmo/MooseX-Types.git / commitdiff