X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=fb657ca04d7ebf6b55997edc9780c5b02af29b33;hb=ddbae99e7b6aab832726f3b7d03d50c7a1cea22b;hp=4ab0006902304a5a835adea991b9e8d9794e4ffb;hpb=898733eb1f3e00977afe3539faae499cb41e550f;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 4ab0006..fb657ca 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -41,7 +41,7 @@ Moose::Exporter->setup_import_methods( type subtype class_type role_type maybe_type duck_type as where message optimize_as inline_as coerce from via - enum + enum union find_type_constraint register_type_constraint match_on_type ) @@ -69,13 +69,26 @@ sub export_type_constraints_as_functions { } sub create_type_constraint_union { + _create_type_constraint_union(\@_); +} + +sub create_named_type_constraint_union { + my $name = shift; + _create_type_constraint_union($name, \@_); +} + +sub _create_type_constraint_union { + my $name; + $name = shift if @_ > 1; + my @tcs = @{ shift() }; + my @type_constraint_names; - if ( scalar @_ == 1 && _detect_type_constraint_union( $_[0] ) ) { - @type_constraint_names = _parse_type_constraint_union( $_[0] ); + if ( scalar @tcs == 1 && _detect_type_constraint_union( $tcs[0] ) ) { + @type_constraint_names = _parse_type_constraint_union( $tcs[0] ); } else { - @type_constraint_names = @_; + @type_constraint_names = @tcs; } ( scalar @type_constraint_names >= 2 ) @@ -88,10 +101,15 @@ sub create_type_constraint_union { "Could not locate type constraint ($_) for the union"); } @type_constraint_names; - return Moose::Meta::TypeConstraint::Union->new( - type_constraints => \@type_constraints ); + my %options = ( + type_constraints => \@type_constraints + ); + $options{name} = $name if defined $name; + + return Moose::Meta::TypeConstraint::Union->new(%options); } + sub create_parameterized_type_constraint { my $type_constraint_name = shift; my ( $base_type, $type_parameter ) @@ -137,15 +155,30 @@ sub create_class_type_constraint { #find_type_constraint("ClassName")->check($class) # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); + my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) ); + + if (my $type = $REGISTRY->get_type_constraint($class)) { + if (!($type->isa('Moose::Meta::TypeConstraint::Class') && $type->class eq $class)) { + _confess( + "The type constraint '$class' has already been created in " + . $type->_package_defined_in + . " and cannot be created again in " + . $pkg_defined_in ) + } + } + my %options = ( - class => $class, - name => $class, + class => $class, + name => $class, + package_defined_in => $pkg_defined_in, %{ $options || {} }, ); $options{name} ||= "__ANON__"; - Moose::Meta::TypeConstraint::Class->new(%options); + my $tc = Moose::Meta::TypeConstraint::Class->new(%options); + $REGISTRY->add_type_constraint($tc); + return $tc; } sub create_role_type_constraint { @@ -155,15 +188,30 @@ sub create_role_type_constraint { #find_type_constraint("ClassName")->check($class) # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); + my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) ); + + if (my $type = $REGISTRY->get_type_constraint($role)) { + if (!($type->isa('Moose::Meta::TypeConstraint::Role') && $type->role eq $role)) { + _confess( + "The type constraint '$role' has already been created in " + . $type->_package_defined_in + . " and cannot be created again in " + . $pkg_defined_in ) + } + } + my %options = ( - role => $role, - name => $role, + role => $role, + name => $role, + package_defined_in => $pkg_defined_in, %{ $options || {} }, ); $options{name} ||= "__ANON__"; - Moose::Meta::TypeConstraint::Role->new(%options); + my $tc = Moose::Meta::TypeConstraint::Role->new(%options); + $REGISTRY->add_type_constraint($tc); + return $tc; } sub find_or_create_type_constraint { @@ -196,15 +244,15 @@ sub find_or_create_type_constraint { } sub find_or_create_isa_type_constraint { - my $type_constraint_name = shift; + my ($type_constraint_name, $options) = @_; find_or_parse_type_constraint($type_constraint_name) - || create_class_type_constraint($type_constraint_name); + || create_class_type_constraint($type_constraint_name, $options); } sub find_or_create_does_type_constraint { - my $type_constraint_name = shift; + my ($type_constraint_name, $options) = @_; find_or_parse_type_constraint($type_constraint_name) - || create_role_type_constraint($type_constraint_name); + || create_role_type_constraint($type_constraint_name, $options); } sub find_or_parse_type_constraint { @@ -305,21 +353,11 @@ sub subtype { } sub class_type { - register_type_constraint( - create_class_type_constraint( - $_[0], - ( defined( $_[1] ) ? $_[1] : () ), - ) - ); + create_class_type_constraint(@_); } sub role_type ($;$) { - register_type_constraint( - create_role_type_constraint( - $_[0], - ( defined( $_[1] ) ? $_[1] : () ), - ) - ); + create_role_type_constraint(@_); } sub maybe_type { @@ -401,6 +439,25 @@ sub enum { ); } +sub union { + my ( $type_name, @constraints ) = @_; + if ( ref $type_name eq 'ARRAY' ) { + @constraints == 0 + || __PACKAGE__->_throw_error("union called with an array reference and additional arguments."); + @constraints = @$type_name; + $type_name = undef; + } + if ( @constraints == 1 && ref $constraints[0] eq 'ARRAY' ) { + @constraints = @{ $constraints[0] }; + } + if ( defined $type_name ) { + return register_type_constraint( + create_named_type_constraint_union( $type_name, @constraints ) + ); + } + return create_type_constraint_union( @constraints ); +} + sub create_enum_type_constraint { my ( $type_name, $values ) = @_; @@ -713,8 +770,14 @@ __END__ from 'Str', via { 0+$_ }; + class_type 'DateTimeClass', { class => 'DateTime' }; + + role_type 'Barks', { role => 'Some::Library::Role::Barks' }; + enum 'RGBColors', [qw(red green blue)]; + union 'StringOrArray', [qw( String Array )]; + no Moose::Util::TypeConstraints; =head1 DESCRIPTION @@ -920,11 +983,29 @@ just a hashref of parameters: Creates a new subtype of C with the name C<$class> and the metaclass L. + # Create a type called 'Box' which tests for objects which ->isa('Box') + class_type 'Box'; + +By default, the name of the type and the name of the class are the same, but +you can specify both separately. + + # Create a type called 'Box' which tests for objects which ->isa('ObjectLibrary::Box'); + class_type 'Box', { class => 'ObjectLibrary::Box' }; + =item B Creates a C type constraint with the name C<$role> and the metaclass L. + # Create a type called 'Walks' which tests for objects which ->does('Walks') + role_type 'Walks'; + +By default, the name of the type and the name of the role are the same, but +you can specify both separately. + + # Create a type called 'Walks' which tests for objects which ->does('MooseX::Role::Walks'); + role_type 'Walks', { role => 'MooseX::Role::Walks' }; + =item B Creates a type constraint for either C or something of the @@ -971,6 +1052,33 @@ can then be used in an attribute definition like so: isa => enum([qw[ ascending descending ]]), ); +=item B + +This will create a basic subtype where any of the provided constraints +may match in order to satisfy this constraint. + +=item B + +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@constraints> pair, this will create an unnamed union. +This can then be used in an attribute definition like so: + + has 'items' => ( + is => 'ro', + isa => union([qw[ Str ArrayRef ]]), + ); + +This is similar to the existing string union: + + isa => 'Str|ArrayRef' + +except that it supports anonymous elements as child constraints: + + has 'color' => ( + isa => 'ro', + isa => union([ 'Int', enum([qw[ red green blue ]]) ]), + ); + =item B This is just sugar for the type constraint construction syntax. @@ -1191,6 +1299,8 @@ form. This removes any whitespace in the string. =item B +=item B + This can take a union type specification like C<'Int|ArrayRef[Int]'>, or a list of names. It returns a new L object.