X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=06733dfbc70b529e6a1239fe4caf3897ef4d5e81;hb=2ae1457eead0263b687bd59cd3630b893618e551;hp=2b16047c01accea60ce09e0670c1382f3c3d5267;hpb=8de5717850eb1f406e5f71d2ccfac33c72cc490b;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 2b16047..06733df 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.92'; +our $VERSION = '0.95'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -49,7 +49,6 @@ Moose::Exporter->setup_import_methods( register_type_constraint match_on_type ) ], - _export_to_main => 1, ); ## -------------------------------------------------------- @@ -366,6 +365,9 @@ sub duck_type { @methods = @$type_name; $type_name = undef; } + if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) { + @methods = @{ $methods[0] }; + } register_type_constraint( create_duck_type_constraint( @@ -412,6 +414,9 @@ sub enum { @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"); @@ -567,18 +572,19 @@ sub _install_type_coercions ($$) { use re "eval"; my $valid_chars = qr{[\w:\.]}; - my $type_atom = qr{ $valid_chars+ }; + my $type_atom = qr{ (?>$valid_chars+) }x; + my $ws = qr{ (?>\s*) }x; my $any; - my $type = qr{ $valid_chars+ (?: \[ \s* (??{$any}) \s* \] )? }x; + my $type = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; my $type_capture_parts - = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x; + = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; my $type_with_parameter - = qr{ $valid_chars+ \[ \s* (??{$any}) \s* \] }x; + = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; - my $op_union = qr{ \s* \| \s* }x; - my $union = qr{ $type (?: $op_union $type )+ }x; + my $op_union = qr{ $ws \| $ws }x; + my $union = qr{ $type (?> (?: $op_union $type )+ ) }x; $any = qr{ $type | $union }x; @@ -656,7 +662,7 @@ subtype 'Value' => as 'Defined' => where { !ref($_) } => subtype 'Ref' => as 'Defined' => where { ref($_) } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref; -subtype 'Str' => as 'Value' => where {1} => +subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str; subtype 'Num' => as 'Str' => @@ -882,9 +888,9 @@ that hierarchy represented visually. Undef Defined Value - Num - Int Str + Num + Int ClassName RoleName Ref @@ -1026,10 +1032,10 @@ metaclass L. Creates a type constraint for either C or something of the given type. -=item B +=item B This will create a subtype of Object and test to make sure the value -C do the methods in C<@methods>. +C do the methods in C<\@methods>. This is intended as an easy way to accept non-Moose objects that provide a certain interface. If you're using Moose classes, we @@ -1037,20 +1043,20 @@ recommend that you use a C-only Role instead. =item B -If passed an ARRAY reference instead of the C<$name>, C<@methods> -pair, this will create an unnamed duck type. This can be used in an -attribute definition like so: +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@methods> pair, this will create an unnamed duck type. +This can be used in an attribute definition like so: has 'cache' => ( is => 'ro', isa => duck_type( [qw( get_set )] ), ); -=item B +=item B 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. +will match any of the items in C<\@values>. It is case sensitive. See the L for a simple example. B This is not a true proper enum type, it is simply @@ -1058,9 +1064,9 @@ a convenient constraint builder. =item B -If passed an ARRAY reference instead of the C<$name>, C<@values> pair, -this will create an unnamed enum. This can then be used in an attribute -definition like so: +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@values> pair, this will create an unnamed enum. This +can then be used in an attribute definition like so: has 'sort_order' => ( is => 'ro', @@ -1121,59 +1127,69 @@ 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 does not -claim to be as featureful as either of those and does not support any -kind of automatic destructuring bind. However it is suitable for a fair -amount of your dispatching needs, for instance, here is a simple -Perl pretty printer dispatching over the core Moose types. +This is a utility function for doing simple type based dispatching similar to +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. sub ppprint { my $x = shift; - match_on_type $x => - HashRef => sub { + match_on_type $x => ( + HashRef => sub { my $hash = shift; - '{ ' . (join ", " => map { - $_ . ' => ' . ppprint( $hash->{ $_ } ) - } sort keys %$hash ) . ' }' }, - ArrayRef => sub { + '{ ' + . ( + join ", " => map { $_ . ' => ' . ppprint( $hash->{$_} ) } + sort keys %$hash + ) . ' }'; + }, + ArrayRef => sub { my $array = shift; - '[ '.(join ", " => map { ppprint( $_ ) } @$array ).' ]' }, - CodeRef => sub { 'sub { ... }' }, - RegexpRef => sub { 'qr/' . $_ . '/' }, - GlobRef => sub { '*' . B::svref_2object($_)->NAME }, + '[ ' . ( join ", " => map { ppprint($_) } @$array ) . ' ]'; + }, + CodeRef => sub {'sub { ... }'}, + RegexpRef => sub { 'qr/' . $_ . '/' }, + GlobRef => sub { '*' . B::svref_2object($_)->NAME }, Object => sub { $_->can('to_string') ? $_->to_string : $_ }, - ScalarRef => sub { '\\' . ppprint( ${$_} ) }, - Num => sub { $_ }, - Str => sub { '"'. $_ . '"' }, - Undef => sub { 'undef' }, - => sub { die "I don't know what $_ is" }; + ScalarRef => sub { '\\' . ppprint( ${$_} ) }, + Num => sub {$_}, + Str => sub { '"' . $_ . '"' }, + Undef => sub {'undef'}, + => sub { die "I don't know what $_ is" } + ); } Or a simple JSON serializer: sub to_json { my $x = shift; - match_on_type $x => - HashRef => sub { + match_on_type $x => ( + HashRef => sub { my $hash = shift; - '{ ' . (join ", " => map { - '"' . $_ . '" : ' . to_json( $hash->{ $_ } ) - } sort keys %$hash ) . ' }' }, - ArrayRef => sub { + '{ ' + . ( + join ", " => + map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } + sort keys %$hash + ) . ' }'; + }, + ArrayRef => sub { my $array = shift; - '[ ' . (join ", " => map { to_json( $_ ) } @$array ) . ' ]' }, - Num => sub { $_ }, - Str => sub { '"'. $_ . '"' }, - Undef => sub { 'null' }, - => sub { die "$_ is not acceptable json type" }; + '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]'; + }, + Num => sub {$_}, + Str => sub { '"' . $_ . '"' }, + Undef => sub {'null'}, + => sub { die "$_ is not acceptable json type" } + ); } -Based on a mapping of C<$type> to C<\&action>, where C<$type> can be -either a string type or a L object, and -C<\&action> is a CODE ref, this function will dispatch on the first -match for C<$value>. It is possible to have a catch-all at the end -in the form of a C<\&default> CODE ref. +The matcher is done by mapping a C<$type> to an C<\&action>. The C<$type> can +be either a string type or a L object, and +C<\&action> is a subroutine reference. This function will dispatch on the +first match for C<$value>. It is possible to have a catch-all by providing an +additional subroutine reference as the final argument to C. =back @@ -1340,9 +1356,7 @@ Adds C<$type> to the list of parameterizable types =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR @@ -1350,7 +1364,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L