use B 'svref_2object';
use Sub::Exporter;
-our $VERSION = '0.12';
+our $VERSION = '0.14';
our $AUTHORITY = 'cpan:STEVAN';
# Prototyped subs must be predeclared because we have a circular dependency
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
+use Moose::Meta::TypeConstraint::Registry;
my @exports = qw/
type subtype as where message optimize_as
}
}
-{
- 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 || sub { 1 };
-
- 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(0));
-
- ($TYPES{$name}->[0] eq $pkg_defined_in)
- || confess ("The type constraint '$name' has already been created in "
- . $TYPES{$name}->[0] . " and cannot be created again in "
- . $pkg_defined_in)
- 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_union (@) {
- my (@type_constraint_names) = @_;
- return Moose::Meta::TypeConstraint->union(
- map {
- find_type_constraint($_)
- } @type_constraint_names
- );
- }
+sub _create_type_constraint ($$$;$$) {
+ my $name = shift;
+ my $parent = shift;
+ my $check = shift || sub { 1 };
- sub export_type_constraints_as_functions {
- my $pkg = caller();
- no strict 'refs';
- foreach my $constraint (keys %TYPES) {
- *{"${pkg}::${constraint}"} = find_type_constraint($constraint)->_compiled_type_constraint;
- }
+ my ($message, $optimized);
+ for (@_) {
+ $message = $_->{message} if exists $_->{message};
+ $optimized = $_->{optimized} if exists $_->{optimized};
}
+
+ my $pkg_defined_in = scalar(caller(0));
- *Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
+ if (defined $name) {
+ my $type = $REGISTRY->get_type_constraint($name);
- sub list_all_type_constraints { keys %TYPES }
+ ($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 ($$;$$) {
of string which responds true to C<isa('UNIVERSAL')>. This means
that your class B<must> be loaded for this type constraint to
pass. I know this is not ideal for all, but it is a saner
-restriction then most others.
+restriction than most others.
=head2 Use with Other Constraint Modules
=item B<find_type_constraint ($type_name)>
-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<Moose::Meta::TypeConstraint> or a
+derivative. What you do with it from there is up to you :)
=item B<create_type_constraint_union (@type_constraint_names)>
=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.
projects / gitmo/Moose.git / blobdiff