spelling fix

[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 43c5911..81f4d9f 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -155,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 {
@@ -173,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 {
@@ -214,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 {
@@ -323,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 {
@@ -750,6 +770,10 @@ __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 )];
@@ -959,11 +983,29 @@ just a hashref of parameters:
 Creates a new subtype of C<Object> with the name C<$class> and the
 metaclass L<Moose::Meta::TypeConstraint::Class>.
 
+  # 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<role_type ($role, ?$options)>
 
 Creates a C<Role> type constraint with the name C<$role> and the
 metaclass L<Moose::Meta::TypeConstraint::Role>.
 
+  # 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<maybe_type ($type)>
 
 Creates a type constraint for either C<undef> or something of the
@@ -1074,15 +1116,9 @@ The subroutine should return a code string suitable for inlining. You can
 assume that the check will be wrapped in parentheses when it is inlined.
 
 The inlined code should include any checks that your type's parent types
-do. For example, the C<Value> type's inlining sub looks like this:
-
-    sub {
-        'defined(' . $_[1] . ')'
-        . ' && !ref(' . $_[1] . ')'
-    }
-
-Note that it checks if the variable is defined, since it is a subtype of
-the C<Defined> type.  However, to avoid repeating code, this can be optimized as:
+do. If your parent type constraint defines its own inlining, you can simply use
+that to avoid repeating code. For example, here is the inlining code for the
+C<Value> type, which is a subtype of C<Defined>:
 
     sub {
         $_[0]->parent()->_inline_check($_[1])