X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=dc21de893724138c7cbdfe137f266dffb4fc112c;hb=19320607dd1e6217be5f0f7f68db79465d0fb6d9;hp=02610046a0a2340bdd3cee7ce7297f325ca30624;hpb=2351f08e7d635babd893a7951af6ef553ef23cec;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 0261004..dc21de8 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -9,7 +9,7 @@ use List::MoreUtils qw( all ); use Scalar::Util 'blessed'; use Moose::Exporter; -our $VERSION = '0.59'; +our $VERSION = '0.68'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -47,7 +47,8 @@ use Moose::Util::TypeConstraints::OptimizedConstraints; Moose::Exporter->setup_import_methods( as_is => [ qw( - type subtype class_type role_type as where message optimize_as + type subtype class_type role_type maybe_type + as where message optimize_as coerce from via enum find_type_constraint @@ -84,11 +85,11 @@ sub create_type_constraint_union { } (scalar @type_constraint_names >= 2) - || Moose->throw_error("You must pass in at least 2 type names to make a union"); + || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union"); my @type_constraints = map { find_or_parse_type_constraint($_) || - Moose->throw_error("Could not locate type constraint ($_) for the union"); + __PACKAGE__->_throw_error("Could not locate type constraint ($_) for the union"); } @type_constraint_names; return Moose::Meta::TypeConstraint::Union->new( @@ -101,31 +102,39 @@ sub create_parameterized_type_constraint { my ($base_type, $type_parameter) = _parse_parameterized_type_constraint($type_constraint_name); (defined $base_type && defined $type_parameter) - || Moose->throw_error("Could not parse type name ($type_constraint_name) correctly"); - - # We need to get the relevant type constraints and use them to - # create the name to ensure that we end up with the fully - # normalized name, because the user could've passed something like - # HashRef[Str|Int] and we want to make that HashRef[Int|Str]. - my $base_type_tc = $REGISTRY->get_type_constraint($base_type) - || Moose->throw_error("Could not locate the base type ($base_type)"); - my $parameter_tc = find_or_create_isa_type_constraint($type_parameter) - || Moose->throw_error("Could not locate the parameter type ($type_parameter)"); - - return Moose::Meta::TypeConstraint::Parameterized->new( - name => $base_type_tc->name . '[' . $parameter_tc->name . ']', - parent => $base_type_tc, - type_parameter => $parameter_tc, - ); + || __PACKAGE__->_throw_error("Could not parse type name ($type_constraint_name) correctly"); + + if ($REGISTRY->has_type_constraint($base_type)) { + my $base_type_tc = $REGISTRY->get_type_constraint($base_type); + return _create_parameterized_type_constraint( + $base_type_tc, + $type_parameter + ); + } else { + __PACKAGE__->_throw_error("Could not locate the base type ($base_type)"); + } } +sub _create_parameterized_type_constraint { + my ( $base_type_tc, $type_parameter ) = @_; + if ( $base_type_tc->can('parameterize') ) { + return $base_type_tc->parameterize($type_parameter); + } else { + return Moose::Meta::TypeConstraint::Parameterized->new( + name => $base_type_tc->name . '[' . $type_parameter . ']', + parent => $base_type_tc, + type_parameter => find_or_create_isa_type_constraint($type_parameter), + ); + } +} + #should we also support optimized checks? sub create_class_type_constraint { my ( $class, $options ) = @_; # too early for this check #find_type_constraint("ClassName")->check($class) - # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name"); + # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); my %options = ( class => $class, @@ -143,7 +152,7 @@ sub create_role_type_constraint { # too early for this check #find_type_constraint("ClassName")->check($class) - # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name"); + # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); my %options = ( role => $role, @@ -243,7 +252,7 @@ sub find_type_constraint { sub register_type_constraint { my $constraint = shift; - Moose->throw_error("can't register an unnamed type constraint") unless defined $constraint->name; + __PACKAGE__->_throw_error("can't register an unnamed type constraint") unless defined $constraint->name; $REGISTRY->add_type_constraint($constraint); return $constraint; } @@ -293,6 +302,14 @@ sub role_type ($;$) { ); } +sub maybe_type { + my ($type_parameter) = @_; + + register_type_constraint( + $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter) + ); +} + sub coerce { my ($type_name, @coercion_map) = @_; _install_type_coercions($type_name, \@coercion_map); @@ -317,7 +334,7 @@ sub enum { $type_name = undef; } (scalar @values >= 2) - || Moose->throw_error("You must have at least two values to enumerate through"); + || __PACKAGE__->_throw_error("You must have at least two values to enumerate through"); my %valid = map { $_ => 1 } @values; register_type_constraint( @@ -346,15 +363,15 @@ sub _create_type_constraint ($$$;$$) { my $parent = shift; my $check = shift; - my ($message, $optimized); + my ( $message, $optimized ); for (@_) { $message = $_->{message} if exists $_->{message}; $optimized = $_->{optimized} if exists $_->{optimized}; } - my $pkg_defined_in = scalar(caller(0)); + my $pkg_defined_in = scalar( caller(0) ); - if (defined $name) { + if ( defined $name ) { my $type = $REGISTRY->get_type_constraint($name); ( $type->_package_defined_in eq $pkg_defined_in ) @@ -364,39 +381,30 @@ sub _create_type_constraint ($$$;$$) { . " and cannot be created again in " . $pkg_defined_in ) if defined $type; - } - my $class = "Moose::Meta::TypeConstraint"; - - # FIXME should probably not be a special case - if ( defined $parent and $parent = find_or_parse_type_constraint($parent) ) { - $class = "Moose::Meta::TypeConstraint::Parameterizable" - if $parent->isa("Moose::Meta::TypeConstraint::Parameterizable"); + $name =~ /^[\w:\.]+$/ + or die qq{$name contains invalid characters for a type name.} + . qq{Names can contain alphanumeric character, ":", and "."\n}; } - my $constraint = $class->new( - name => $name || '__ANON__', + my %opts = ( + name => $name, package_defined_in => $pkg_defined_in, - ($parent ? (parent => $parent ) : ()), - ($check ? (constraint => $check) : ()), - ($message ? (message => $message) : ()), - ($optimized ? (optimized => $optimized) : ()), + ( $check ? ( constraint => $check ) : () ), + ( $message ? ( message => $message ) : () ), + ( $optimized ? ( optimized => $optimized ) : () ), ); - # NOTE: - # if we have a type constraint union, and no - # type check, this means we are just aliasing - # the union constraint, which means we need to - # handle this differently. - # - SL - if (not(defined $check) - && $parent->isa('Moose::Meta::TypeConstraint::Union') - && $parent->has_coercion - ){ - $constraint->coercion(Moose::Meta::TypeCoercion::Union->new( - type_constraint => $parent - )); + my $constraint; + if ( defined $parent + and $parent + = blessed $parent ? $parent : find_or_create_isa_type_constraint($parent) ) + { + $constraint = $parent->create_child_type(%opts); + } + else { + $constraint = Moose::Meta::TypeConstraint->new(%opts); } $REGISTRY->add_type_constraint($constraint) @@ -409,7 +417,7 @@ sub _install_type_coercions ($$) { my ($type_name, $coercion_map) = @_; my $type = find_type_constraint($type_name); (defined $type) - || Moose->throw_error("Cannot find type '$type_name', perhaps you forgot to load it."); + || __PACKAGE__->_throw_error("Cannot find type '$type_name', perhaps you forgot to load it."); if ($type->has_coercion) { $type->coercion->add_type_coercions(@$coercion_map); } @@ -435,7 +443,7 @@ sub _install_type_coercions ($$) { use re "eval"; - my $valid_chars = qr{[\w:]}; + my $valid_chars = qr{[\w:\.]}; my $type_atom = qr{ $valid_chars+ }; my $any; @@ -468,7 +476,7 @@ sub _install_type_coercions ($$) { push @rv => $1; } (pos($given) eq length($given)) - || Moose->throw_error("'$given' didn't parse (parse-pos=" + || __PACKAGE__->_throw_error("'$given' didn't parse (parse-pos=" . pos($given) . " and str-length=" . length($given) @@ -486,6 +494,27 @@ 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. +$_->make_immutable( + inline_constructor => 1, + constructor_name => "_new", + + # these are Class::MOP accessors, so they need inlining + inline_accessors => 1 + ) for grep { $_->is_mutable } + map { $_->meta } + qw( + Moose::Meta::TypeConstraint + Moose::Meta::TypeConstraint::Union + Moose::Meta::TypeConstraint::Parameterized + Moose::Meta::TypeConstraint::Parameterizable + Moose::Meta::TypeConstraint::Class + Moose::Meta::TypeConstraint::Role + Moose::Meta::TypeConstraint::Enum + Moose::Meta::TypeConstraint::Registry +); + type 'Any' => where { 1 }; # meta-type including all type 'Item' => where { 1 }; # base-type @@ -620,7 +649,7 @@ sub get_all_parameterizable_types { @PARAMETERIZABLE_TYPES } sub add_parameterizable_type { my $type = shift; (blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable')) - || Moose->throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type"); + || __PACKAGE__->_throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type"); push @PARAMETERIZABLE_TYPES => $type; } @@ -633,6 +662,12 @@ sub add_parameterizable_type { sub list_all_builtin_type_constraints { @BUILTINS } } +sub _throw_error { + require Moose; + unshift @_, 'Moose'; + goto &Moose::throw_error; +} + 1; __END__ @@ -667,7 +702,7 @@ Moose::Util::TypeConstraints - Type constraint system for Moose =head1 DESCRIPTION This module provides Moose with the ability to create custom type -contraints to be used in attribute definition. +constraints to be used in attribute definition. =head2 Important Caveat @@ -729,7 +764,7 @@ that hierarchy represented visually. GlobRef FileHandle Object - Role + Role B Any type followed by a type parameter C<[`a]> can be parameterized, this means you can say: @@ -738,13 +773,17 @@ parameterized, this means you can say: HashRef[CodeRef] # a hash of str to CODE ref mappings Maybe[Str] # value may be a string, may be undefined +If Moose finds a name in brackets that it does not recognize as an +existing type, it assumes that this is a class name, for example +C. + B Unless you parameterize a type, then it is invalid to include the square brackets. I.e. C will be literally interpreted as a type name. B The C type constraint for the most part works correctly now, but edge cases may still exist, please use it -sparringly. +sparingly. B The C type constraint does a complex package existence check. This means that your class B be loaded for @@ -753,10 +792,13 @@ but it is a saner restriction than most others. =head2 Type Constraint Naming +Type name declared via this module can only contain alphanumeric +characters, colons (:), and periods (.). + Since the types created by this module are global, it is suggested that you namespace your types just as you would namespace your modules. So instead of creating a I type for your B -module, you would call the type I instead. +module, you would call the type I instead. =head2 Use with Other Constraint Modules @@ -813,6 +855,9 @@ This creates a base type, which has no parent. This creates a named subtype. +If you provide a parent that Moose does not recognize, it will +automatically create a new class type constraint for this name. + =item B This creates an unnamed subtype and will return the type @@ -829,6 +874,11 @@ L. Creates a type constraint with the name C<$role> and the metaclass L. +=item B + +Creates a type constraint for either C or something of the +given type. + =item B This will create a basic subtype for a given set of strings. @@ -836,8 +886,8 @@ 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. -B This is not a true proper enum type, it is simple -a convient constraint builder. +B This is not a true proper enum type, it is simply +a convenient constraint builder. =item B @@ -876,7 +926,7 @@ exception thrown. This can be used to define a "hand optimized" version of your type constraint which can be used to avoid traversing a subtype -constraint heirarchy. +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 @@ -917,9 +967,9 @@ This is just sugar for the type coercion construction syntax. Given a string that is expected to match a type constraint, will normalize the string so that extra whitespace and newlines are removed. -=item B +=item B -Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>, +Given string with C<$pipe_separated_types> or a list of C<@type_constraint_names>, this will return a L instance. =item B @@ -964,7 +1014,7 @@ C. =item B -Attempts to parse the type name using L and if +Attempts to parse the type name using C and if no appropriate constraint is found will create a new anonymous one. The C variant will use C and the C @@ -1036,7 +1086,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L