X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=375e5f4fca58c634f76668485bbc0e6ea490ac38;hb=2c739d1aa02657fcc42afa4b737d2e207d29567e;hp=cfea18fdb253baaba2b87b070e4424fcb0126a61;hpb=150e51428b8826acfd85b66a55e1a473982843e4;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index cfea18f..375e5f4 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -6,10 +6,6 @@ use List::MoreUtils qw( all any ); use Scalar::Util qw( blessed reftype ); use Moose::Exporter; -our $VERSION = '0.95'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - ## -------------------------------------------------------- # Prototyped subs must be predeclared because we have a # circular dependency with Moose::Meta::Attribute et. al. @@ -25,6 +21,7 @@ sub optimize_as (&); ## -------------------------------------------------------- +use Moose::Deprecated; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeConstraint::Union; use Moose::Meta::TypeConstraint::Parameterized; @@ -275,6 +272,12 @@ sub type { # back-compat version, called without sugar if ( !any { ( reftype($_) || '' ) eq 'HASH' } @_ ) { + Moose::Deprecated::deprecated( + feature => 'type without sugar', + message => + 'Calling type() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.' + ); + return _create_type_constraint( $_[0], undef, $_[1] ); } @@ -294,6 +297,12 @@ sub subtype { # # subtype 'Parent', sub { where }; if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) { + Moose::Deprecated::deprecated( + feature => 'subtype without sugar', + message => + 'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.' + ); + return _create_type_constraint( undef, @_ ); } @@ -301,11 +310,23 @@ sub subtype { # subtype 'Parent', sub { where }, sub { message }, sub { optimized }; if ( scalar @_ >= 3 && all { ( reftype($_) || '' ) eq 'CODE' } @_[ 1 .. $#_ ] ) { + Moose::Deprecated::deprecated( + feature => 'subtype without sugar', + message => + 'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.' + ); + return _create_type_constraint( undef, @_ ); } # subtype 'Name', 'Parent', ... if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) { + Moose::Deprecated::deprecated( + feature => 'subtype without sugar', + message => + 'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.' + ); + return _create_type_constraint(@_); } @@ -410,17 +431,16 @@ sub enum { # if only an array-ref is passed then # you get an anon-enum # - SL - if ( ref $type_name eq 'ARRAY' && !@values ) { + if ( ref $type_name eq 'ARRAY' ) { + @values == 0 + || __PACKAGE__->_throw_error("enum called with an array reference and additional arguments. Did you mean to parenthesize the enum call's parameters?"); + @values = @$type_name; $type_name = undef; } if ( @values == 1 && ref $values[0] eq 'ARRAY' ) { @values = @{ $values[0] }; } - ( scalar @values >= 2 ) - || __PACKAGE__->_throw_error( - "You must have at least two values to enumerate through"); - my %valid = map { $_ => 1 } @values; register_type_constraint( create_enum_type_constraint( @@ -573,20 +593,53 @@ sub _install_type_coercions ($$) { my $valid_chars = qr{[\w:\.]}; my $type_atom = qr{ (?>$valid_chars+) }x; - my $ws = qr{ (?>\s*) }x; - - my $any; - - my $type = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; - my $type_capture_parts - = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; - my $type_with_parameter - = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; - - my $op_union = qr{ $ws \| $ws }x; - my $union = qr{ $type (?> (?: $op_union $type )+ ) }x; + my $ws = qr{ (?>\s*) }x; + my $op_union = qr{ $ws \| $ws }x; + + my ($type, $type_capture_parts, $type_with_parameter, $union, $any); + if (Class::MOP::IS_RUNNING_ON_5_10) { + my $type_pattern + = q{ (?&type_atom) (?: \[ (?&ws) (?&any) (?&ws) \] )? }; + my $type_capture_parts_pattern + = q{ ((?&type_atom)) (?: \[ (?&ws) ((?&any)) (?&ws) \] )? }; + my $type_with_parameter_pattern + = q{ (?&type_atom) \[ (?&ws) (?&any) (?&ws) \] }; + my $union_pattern + = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) }; + my $any_pattern + = q{ (?&type) | (?&union) }; + + my $defines = qr{(?(DEFINE) + (? $valid_chars) + (? $type_atom) + (? $ws) + (? $op_union) + (? $type_pattern) + (? $type_capture_parts_pattern) + (? $type_with_parameter_pattern) + (? $union_pattern) + (? $any_pattern) + )}x; + + $type = qr{ $type_pattern $defines }x; + $type_capture_parts = qr{ $type_capture_parts_pattern $defines }x; + $type_with_parameter = qr{ $type_with_parameter_pattern $defines }x; + $union = qr{ $union_pattern $defines }x; + $any = qr{ $any_pattern $defines }x; + } + else { + $type + = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; + $type_capture_parts + = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; + $type_with_parameter + = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; + $union + = qr{ $type (?> (?: $op_union $type )+ ) }x; + $any + = qr{ $type | $union }x; + } - $any = qr{ $type | $union }x; sub _parse_parameterized_type_constraint { { no warnings 'void'; $any; } # force capture of interpolated lexical @@ -674,9 +727,9 @@ subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } => subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef; -subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => - optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef; +subtype 'RegexpRef' => as 'Ref' => + where(\&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef) => + optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef; subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef; @@ -688,10 +741,8 @@ subtype 'FileHandle' => as 'GlobRef' => where { } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle; -# NOTE: -# blessed(qr/.../) returns true,.. how odd subtype 'Object' => as 'Ref' => - where { blessed($_) && blessed($_) ne 'Regexp' } => + where { blessed($_) } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object; # This type is deprecated. @@ -822,32 +873,30 @@ sub _throw_error { 1; +# ABSTRACT: Type constraint system for Moose + __END__ =pod -=head1 NAME - -Moose::Util::TypeConstraints - Type constraint system for Moose - =head1 SYNOPSIS use Moose::Util::TypeConstraints; - subtype 'Natural' - => as 'Int' - => where { $_ > 0 }; + subtype 'Natural', + as 'Int', + where { $_ > 0 }; - subtype 'NaturalLessThanTen' - => as 'Natural' - => where { $_ < 10 } - => message { "This number ($_) is not less than ten!" }; + subtype 'NaturalLessThanTen', + as 'Natural', + where { $_ < 10 }, + message { "This number ($_) is not less than ten!" }; - coerce 'Num' - => from 'Str' - => via { 0+$_ }; + coerce 'Num', + from 'Str', + via { 0+$_ }; - enum 'RGBColors' => qw(red green blue); + enum 'RGBColors', [qw(red green blue)]; no Moose::Util::TypeConstraints; @@ -889,7 +938,7 @@ this, as well as future proof your subtypes from classes which have yet to have been created, is to quote the type name: use DateTime; - subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') }; + subtype 'DateTime', as 'Object', where { $_->isa('DateTime') }; =head2 Default Type Constraints @@ -968,21 +1017,21 @@ For instance, this is how you could use it with L to declare a completely new type. type 'HashOfArrayOfObjects', - { - where => IsHashRef( - -keys => HasLength, - -values => IsArrayRef(IsObject) - ) - }; - -For more examples see the F test + where { + IsHashRef( + -keys => HasLength, + -values => IsArrayRef(IsObject) + )->(@_); + }; + +For more examples see the F test file. Here is an example of using L and it's non-test related C function. - type 'ArrayOfHashOfBarsAndRandomNumbers' - => where { + type 'ArrayOfHashOfBarsAndRandomNumbers', + where { eq_deeply($_, array_each(subhashof({ bar => isa('Bar'), @@ -991,7 +1040,23 @@ related C function. }; For a complete example see the -F test file. +F test file. + +=head2 Error messages + +Type constraints can also specify custom error messages, for when they fail to +validate. This is provided as just another coderef, which receives the invalid +value in C<$_>, as in: + + subtype 'PositiveInt', + as 'Int', + where { $_ > 0 }, + message { "$_ is not a positive integer!" }; + +If no message is specified, a default message will be used, which indicates +which type constraint was being used and what value failed. If +L (version 0.14 or higher) is installed, it will be used to +display the invalid value, otherwise it will just be printed as is. =head1 FUNCTIONS @@ -1001,11 +1066,11 @@ The following functions are used to create type constraints. They will also register the type constraints your create in a global registry that is used to look types up by name. -See the L for an example of how to use these. +See the L for an example of how to use these. =over 4 -=item B<< subtype 'Name' => as 'Parent' => where { } ... >> +=item B<< subtype 'Name', as 'Parent', where { } ... >> This creates a named subtype. @@ -1021,7 +1086,7 @@ name and a hashref of parameters: The valid hashref keys are C (the parent), C, C, and C. -=item B<< subtype as 'Parent' => where { } ... >> +=item B<< subtype as 'Parent', where { } ... >> This creates an unnamed subtype and will return the type constraint meta-object, which will be an instance of @@ -1073,7 +1138,7 @@ This can be used in an attribute definition like so: This will create a basic subtype for a given set of strings. The resulting constraint will be a subtype of C and will match any of the items in C<\@values>. It is case sensitive. -See the L for a simple example. +See the L for a simple example. B This is not a true proper enum type, it is simply a convenient constraint builder. @@ -1119,11 +1184,11 @@ This can be used to define a "hand optimized" version of your type constraint which can be used to avoid traversing a subtype constraint hierarchy. -B You should only use this if you know what you are doing, -all the built in types use this, so your subtypes (assuming they +B You should only use this if you know what you are doing. +All the built in types use this, so your subtypes (assuming they are shallow) will not likely need to use this. -=item B<< type 'Name' => where { } ... >> +=item B<< type 'Name', where { } ... >> This creates a base type, which has no parent. @@ -1218,15 +1283,21 @@ the type-coercion code first, followed by the type constraint check. This feature should be used carefully as it is very powerful and could easily take off a limb if you are not careful. -See the L for an example of how to use these. +See the L for an example of how to use these. =over 4 -=item B<< coerce 'Name' => from 'OtherName' => via { ... } >> +=item B<< coerce 'Name', from 'OtherName', via { ... } >> This defines a coercion from one type to another. The C argument is the type you are coercing I. +To define multiple coercions, supply more sets of from/via pairs: + + coerce 'Name', + from 'OtherName', via { ... }, + from 'ThirdName', via { ... }; + =item B This is just sugar for the type coercion construction syntax. @@ -1330,7 +1401,7 @@ global registry. =item B These functions will first call C. If -that function does not return a type, a new anonymous type object will +that function does not return a type, a new type object will be created. The C variant will use C and the @@ -1374,17 +1445,4 @@ Adds C<$type> to the list of parameterizable types See L for details on reporting bugs. -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2010 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =cut