X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=26f872a0155e63f402b856363ce15763afd68b00;hb=f4b86ac0e1fd7ff8a180f2f8332821170db5371e;hp=34652143a460b56adee9d756ed8fe29617d7f618;hpb=870d0f1a40aafaeab1155cae153ac60c47cd12ec;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 3465214..26f872a 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -6,7 +6,7 @@ use List::MoreUtils qw( all any ); use Scalar::Util qw( blessed reftype ); use Moose::Exporter; -our $VERSION = '0.94'; +our $VERSION = '1.16'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -25,6 +25,7 @@ sub optimize_as (&); ## -------------------------------------------------------- +use Moose::Deprecated; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeConstraint::Union; use Moose::Meta::TypeConstraint::Parameterized; @@ -275,6 +276,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' + ); + return _create_type_constraint( $_[0], undef, $_[1] ); } @@ -294,6 +301,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' + ); + return _create_type_constraint( undef, @_ ); } @@ -301,11 +314,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' + ); + 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' + ); + return _create_type_constraint(@_); } @@ -410,17 +435,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 +597,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 @@ -672,9 +729,6 @@ subtype 'Num' => as 'Str' => subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int; -subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => - optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef; subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef; subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => @@ -717,6 +771,24 @@ subtype 'RoleName' => as 'ClassName' => where { $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'), @@ -775,7 +847,7 @@ $REGISTRY->add_type_constraint( ); my @PARAMETERIZABLE_TYPES - = map { $REGISTRY->get_type_constraint($_) } qw[ArrayRef HashRef Maybe]; + = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe]; sub get_all_parameterizable_types {@PARAMETERIZABLE_TYPES} @@ -894,7 +966,7 @@ that hierarchy represented visually. ClassName RoleName Ref - ScalarRef + ScalarRef[`a] ArrayRef[`a] HashRef[`a] CodeRef @@ -908,6 +980,7 @@ parameterized, this means you can say: ArrayRef[Int] # an array of integers HashRef[CodeRef] # a hash of str to CODE ref mappings + ScalarRef[Int] # a reference to an integer Maybe[Str] # value may be a string, may be undefined If Moose finds a name in brackets that it does not recognize as an @@ -985,7 +1058,7 @@ 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 @@ -1057,7 +1130,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. @@ -1128,7 +1201,7 @@ The valid hashref keys are C, C, and C. =item B<< match_on_type $value => ( $type => \&action, ... ?\&default ) >> This is a utility function for doing simple type based dispatching similar to -match/case in O'Caml and case/of in Haskell. It is not as featureful as those +match/case in OCaml and case/of in Haskell. It is not as featureful as those languages, nor does not it support any kind of automatic destructuring bind. Here is a simple Perl pretty printer dispatching over the core Moose types. @@ -1202,7 +1275,7 @@ 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