X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=8dd81700c934938039a74030d168a86d27eb07ea;hb=22aed3c0fbe058c938ecb2834eb8a45c46d4e8ed;hp=636ba2f9e19a1b934dac22a5a105ea0b838277b2;hpb=587ae0d2067068a8ad38926a4f4104aba21270f4;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 636ba2f..8dd8170 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -5,14 +5,36 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'blessed'; +use Scalar::Util 'blessed', 'reftype'; use B 'svref_2object'; use Sub::Exporter; -our $VERSION = '0.10'; +our $VERSION = '0.14'; +our $AUTHORITY = 'cpan:STEVAN'; + +# Prototyped subs must be predeclared because we have a circular dependency +# with Moose::Meta::Attribute et. al. so in case of us being use'd first the +# predeclaration ensures the prototypes are in scope when consumers are +# compiled + +sub find_type_constraint ($); +sub _create_type_constraint ($$$;$$); +sub _install_type_coercions ($$); +sub create_type_constraint_union (@); +sub type ($$;$$); +sub subtype ($$;$$$); +sub coerce ($@); +sub as ($); +sub from ($); +sub where (&); +sub via (&); +sub message (&); +sub optimize_as (&); +sub enum ($;@); use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; +use Moose::Meta::TypeConstraint::Registry; my @exports = qw/ type subtype as where message optimize_as @@ -46,85 +68,108 @@ sub unimport { } } -{ - my %TYPES; - sub find_type_constraint ($) { - return $TYPES{$_[0]}->[1] - if exists $TYPES{$_[0]}; - return; - } - - sub _dump_type_constraints { - require Data::Dumper; - Data::Dumper::Dumper(\%TYPES); - } - - sub _create_type_constraint ($$$;$$) { - my $name = shift; - my $parent = shift; - my $check = shift;; - - my ($message, $optimized); - for (@_) { - $message = $_->{message} if exists $_->{message}; - $optimized = $_->{optimized} if exists $_->{optimized}; - } +my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new; - my $pkg_defined_in = scalar(caller(1)); - ($TYPES{$name}->[0] eq $pkg_defined_in) - || confess "The type constraint '$name' has already been created " - if defined $name && exists $TYPES{$name}; - $parent = find_type_constraint($parent) if defined $parent; - my $constraint = Moose::Meta::TypeConstraint->new( - name => $name || '__ANON__', - parent => $parent, - constraint => $check, - message => $message, - optimized => $optimized, - ); - $TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name; - return $constraint; - } +sub _get_type_constraint_registry { $REGISTRY } +sub _dump_type_constraints { $REGISTRY->dump } - sub _install_type_coercions ($$) { - my ($type_name, $coercion_map) = @_; - my $type = find_type_constraint($type_name); - (!$type->has_coercion) - || confess "The type coercion for '$type_name' has already been registered"; - my $type_coercion = Moose::Meta::TypeCoercion->new( - type_coercion_map => $coercion_map, - type_constraint => $type - ); - $type->coercion($type_coercion); - } +sub _create_type_constraint ($$$;$$) { + my $name = shift; + my $parent = shift; + my $check = shift || sub { 1 }; - sub create_type_constraint_union (@) { - my (@type_constraint_names) = @_; - return Moose::Meta::TypeConstraint->union( - map { - find_type_constraint($_) - } @type_constraint_names - ); + my ($message, $optimized); + for (@_) { + $message = $_->{message} if exists $_->{message}; + $optimized = $_->{optimized} if exists $_->{optimized}; } + + my $pkg_defined_in = scalar(caller(0)); + + if (defined $name) { + my $type = $REGISTRY->get_type_constraint($name); - sub export_type_contstraints_as_functions { - my $pkg = caller(); - no strict 'refs'; - foreach my $constraint (keys %TYPES) { - *{"${pkg}::${constraint}"} = find_type_constraint($constraint)->_compiled_type_constraint; - } - } + ($type->_package_defined_in eq $pkg_defined_in) + || confess ("The type constraint '$name' has already been created in " + . $type->_package_defined_in . " and cannot be created again in " + . $pkg_defined_in) + if defined $type; + } + + $parent = $REGISTRY->get_type_constraint($parent) if defined $parent; + my $constraint = Moose::Meta::TypeConstraint->new( + name => $name || '__ANON__', + parent => $parent, + constraint => $check, + message => $message, + optimized => $optimized, + package_defined_in => $pkg_defined_in, + ); + + $REGISTRY->add_type_constraint($constraint) + if defined $name; + + return $constraint; } +sub _install_type_coercions ($$) { + my ($type_name, $coercion_map) = @_; + my $type = $REGISTRY->get_type_constraint($type_name); + (!$type->has_coercion) + || confess "The type coercion for '$type_name' has already been registered"; + my $type_coercion = Moose::Meta::TypeCoercion->new( + type_coercion_map => $coercion_map, + type_constraint => $type + ); + $type->coercion($type_coercion); +} + +sub create_type_constraint_union (@) { + my (@type_constraint_names) = @_; + return Moose::Meta::TypeConstraint->union( + map { + $REGISTRY->get_type_constraint($_) + } @type_constraint_names + ); +} + +sub export_type_constraints_as_functions { + my $pkg = caller(); + no strict 'refs'; + foreach my $constraint (keys %{$REGISTRY->type_constraints}) { + *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint) + ->_compiled_type_constraint; + } +} + +*Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions; + +sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} } + +## -------------------------------------------------------- +## exported functions ... +## -------------------------------------------------------- + +sub find_type_constraint ($) { $REGISTRY->get_type_constraint(@_) } + # type constructors -sub type ($$) { - my ($name, $check) = @_; - _create_type_constraint($name, undef, $check); +sub type ($$;$$) { + splice(@_, 1, 0, undef); + goto &_create_type_constraint; } sub subtype ($$;$$$) { - unshift @_ => undef if scalar @_ <= 2; + # NOTE: + # this adds an undef for the name + # if this is an anon-subtype: + # subtype(Num => where { $_ % 2 == 0 }) # anon 'even' subtype + # but if the last arg is not a code + # ref then it is a subtype alias: + # subtype(MyNumbers => as Num); # now MyNumbers is the same as Num + # ... yeah I know it's ugly code + # - SL + unshift @_ => undef if scalar @_ <= 2 && (reftype($_[1]) || '') eq 'CODE'; goto &_create_type_constraint; } @@ -216,6 +261,16 @@ subtype 'Role' => as 'Object' => where { $_->can('does') } => optimize_as { blessed($_[0]) && $_[0]->can('does') }; + +subtype 'ClassName' + => as 'Str' + => where { eval { $_->isa('UNIVERSAL') } } + => optimize_as { !ref($_[0]) && eval { $_[0]->isa('UNIVERSAL') } }; + +{ + my @BUILTINS = list_all_type_constraints(); + sub list_all_builtin_type_constraints { @BUILTINS } +} 1; @@ -250,9 +305,8 @@ Moose::Util::TypeConstraints - Type constraint system for Moose =head1 DESCRIPTION -This module provides Moose with the ability to create type contraints -to be are used in both attribute definitions and for method argument -validation. +This module provides Moose with the ability to create custom type +contraints to be used in attribute definition. =head2 Important Caveat @@ -285,7 +339,7 @@ this, as well as future proof your subtypes from classes which have yet to have been created yet, is to simply do this: use DateTime; - subtype 'DateTime' => as Object => where { $_->isa('DateTime') }; + subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') }; =head2 Default Type Constraints @@ -301,6 +355,7 @@ could probably use some work, but it works for me at the moment. Num Int Str + ClassName Ref ScalarRef ArrayRef @@ -316,6 +371,46 @@ Suggestions for improvement are welcome. B The C type constraint does not work correctly in every occasion, please use it sparringly. + +B The C type constraint is simply a subtype +of string which responds true to C. This means +that your class B be loaded for this type constraint to +pass. I know this is not ideal for all, but it is a saner +restriction than most others. + +=head2 Use with Other Constraint Modules + +This module should play fairly nicely with other constraint +modules with only some slight tweaking. The C clause +in types is expected to be a C reference which checks +it's first argument and returns a bool. Since most constraint +modules work in a similar way, it should be simple to adapt +them to work with Moose. + +For instance, this is how you could use it with +L to declare a completely new type. + + type 'HashOfArrayOfObjects' + => 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 +related C function. + + type 'ArrayOfHashOfBarsAndRandomNumbers' + => where { + eq_deeply($_, + array_each(subhashof({ + bar => isa('Bar'), + random_number => ignore() + }))) + }; + +For a complete example see the F +test file. =head1 FUNCTIONS @@ -325,20 +420,37 @@ in every occasion, please use it sparringly. =item B -This function can be used to locate a specific type constraint -meta-object. What you do with it from there is up to you :) +This function can be used to locate a specific type constraint +meta-object, of the class L or a +derivative. What you do with it from there is up to you :) =item B Given a list of C<@type_constraint_names>, this will return a B instance. -=item B +=item B This will export all the current type constraints as functions into the caller's namespace. Right now, this is mostly used for testing, but it might prove useful to others. +=item B + +Alias for the above function. + +=item B + +This will return a list of type constraint names, you can then +fetch them using C if you +want to. + +=item B + +This will return a list of builtin type constraints, meaning, +those which are defined in this module. See the section +labeled L for a complete list. + =back =head2 Type Constraint Constructors @@ -347,7 +459,7 @@ The following functions are used to create type constraints. They will then register the type constraints in a global store where Moose can get to them if it needs to. -See the L for an example of how to use these. +See the L for an example of how to use these. =over 4 @@ -389,17 +501,25 @@ This is just sugar for the type constraint construction syntax. =item B +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. + +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. + =back =head2 Type Coercion Constructors Type constraints can also contain type coercions as well. If you -ask your accessor too coerce, the Moose will run the type-coercion +ask your accessor to coerce, then Moose will run 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 @@ -438,7 +558,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006, 2007 by Infinity Interactive, Inc. L