X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=59d635cd9e0389e98b3db351c27f071f70157628;hb=4e36cf24ed778c7e59d4ac43a0560df07790b5bd;hp=9fe4cf288d14ea9096fa58441d0c6a55e28c21cc;hpb=3eb89f709f04907580b508f821d6be2316fcb65f;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 9fe4cf2..59d635c 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 = '1.01'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - ## -------------------------------------------------------- # Prototyped subs must be predeclared because we have a # circular dependency with Moose::Meta::Attribute et. al. @@ -22,9 +18,11 @@ sub where (&); sub via (&); sub message (&); sub optimize_as (&); +sub inline_as (&); ## -------------------------------------------------------- +use Moose::Deprecated; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeConstraint::Union; use Moose::Meta::TypeConstraint::Parameterized; @@ -36,7 +34,6 @@ use Moose::Meta::TypeConstraint::DuckType; use Moose::Meta::TypeCoercion; use Moose::Meta::TypeCoercion::Union; use Moose::Meta::TypeConstraint::Registry; -use Moose::Util::TypeConstraints::OptimizedConstraints; Moose::Exporter->setup_import_methods( as_is => [ @@ -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] ); } @@ -284,7 +287,7 @@ sub type { return _create_type_constraint( $name, undef, $p{where}, $p{message}, - $p{optimize_as} + $p{optimize_as}, $p{inline_as}, ); } @@ -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(@_); } @@ -329,7 +350,7 @@ sub subtype { return _create_type_constraint( $name, $p{as}, $p{where}, $p{message}, - $p{optimize_as} + $p{optimize_as}, $p{inline_as}, ); } @@ -393,12 +414,13 @@ sub coerce { # # subtype( 'Foo', as( 'Str', where { ... } ) ); # -# If as() returns all it's extra arguments, this just works, and +# If as() returns all its extra arguments, this just works, and # preserves backwards compatibility. sub as { { as => shift }, @_ } sub where (&) { { where => $_[0] } } sub message (&) { { message => $_[0] } } sub optimize_as (&) { { optimize_as => $_[0] } } +sub inline_as (&) { { inline_as => $_[0] } } sub from {@_} sub via (&) { $_[0] } @@ -410,17 +432,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( @@ -491,6 +512,7 @@ sub _create_type_constraint ($$$;$$) { my $check = shift; my $message = shift; my $optimized = shift; + my $inlined = shift; my $pkg_defined_in = scalar( caller(1) ); @@ -517,6 +539,7 @@ sub _create_type_constraint ($$$;$$) { ( $check ? ( constraint => $check ) : () ), ( $message ? ( message => $message ) : () ), ( $optimized ? ( optimized => $optimized ) : () ), + ( $inlined ? ( inlined => $inlined ) : () ), ); my $constraint; @@ -573,20 +596,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 @@ -625,8 +681,9 @@ sub _install_type_coercions ($$) { # define some basic built-in types ## -------------------------------------------------------- -# By making these classes immutable before creating all the types we -# below, we avoid repeatedly calling the slow MOP-based accessors. +# By making these classes immutable before creating all the types in +# Moose::Util::TypeConstraints::Builtin , we avoid repeatedly calling the slow +# MOP-based accessors. $_->make_immutable( inline_constructor => 1, constructor_name => "_new", @@ -647,147 +704,8 @@ $_->make_immutable( Moose::Meta::TypeConstraint::Registry ); -type 'Any' => where {1}; # meta-type including all -subtype 'Item' => as 'Any'; # base-type - -subtype 'Undef' => as 'Item' => where { !defined($_) }; -subtype 'Defined' => as 'Item' => where { defined($_) }; - -subtype 'Bool' => as 'Item' => - where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; - -subtype 'Value' => as 'Defined' => where { !ref($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value; - -subtype 'Ref' => as 'Defined' => where { ref($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref; - -subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str; - -subtype 'Num' => as 'Str' => - where { Scalar::Util::looks_like_number($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num; - -subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int; - -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 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef; - -# NOTE: -# scalar filehandles are GLOB refs, -# but a GLOB ref is not always a filehandle -subtype 'FileHandle' => as 'GlobRef' => where { - Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ); -} => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle; - -# NOTE: -# blessed(qr/.../) returns true,.. how odd -subtype 'Object' => as 'Ref' => - where { blessed($_) && blessed($_) ne 'Regexp' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object; - -# This type is deprecated. -subtype 'Role' => as 'Object' => where { $_->can('does') } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role; - -my $_class_name_checker = sub { }; - -subtype 'ClassName' => as 'Str' => - where { Class::MOP::is_class_loaded($_) } => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName; - -subtype 'RoleName' => as 'ClassName' => where { - (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); -} => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName; - -## -------------------------------------------------------- -# parameterizable types ... - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'ScalarRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - return $check->(${ $_ }); - }; - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'ArrayRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'ARRAY' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x (@$_) { - ( $check->($x) ) || return; - } - 1; - } - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'HashRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'HASH' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x ( values %$_ ) { - ( $check->($x) ) || return; - } - 1; - } - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'Maybe', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Item'), - constraint => sub {1}, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - return 1 if not( defined($_) ) || $check->($_); - return; - } - } - ) -); +require Moose::Util::TypeConstraints::Builtins; +Moose::Util::TypeConstraints::Builtins::define_builtins($REGISTRY); my @PARAMETERIZABLE_TYPES = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe]; @@ -822,32 +740,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 +805,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 @@ -960,7 +876,7 @@ I instead. This module can play nicely with other constraint modules with some slight tweaking. The C clause in types is expected to be a -C reference which checks it's first argument and returns a +C reference which checks its first argument and returns a boolean. Since most constraint modules work in a similar way, it should be simple to adapt them to work with Moose. @@ -968,21 +884,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 +Here is an example of using L and its non-test related C function. - type 'ArrayOfHashOfBarsAndRandomNumbers' - => where { + type 'ArrayOfHashOfBarsAndRandomNumbers', + where { eq_deeply($_, array_each(subhashof({ bar => isa('Bar'), @@ -991,7 +907,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 @@ -1005,7 +937,7 @@ 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 +953,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 @@ -1119,11 +1051,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. @@ -1222,11 +1154,17 @@ 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 +1268,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 +1312,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