X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FAttribute.pm;h=36c907a4546f141083f92249e156bb2e112ab078;hb=f5fbe3cced480252b924d64511d69b325d4ddebd;hp=4c2caf0a9955b2eafdc5e0996338551ef76f184e;hpb=a707f5877879f294bbaa3d0744ddd021c6a2ca9b;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm
index 4c2caf0..36c907a 100644
--- a/lib/Mouse/Attribute.pm
+++ b/lib/Mouse/Attribute.pm
@@ -26,6 +26,16 @@ sub weak_ref        { $_[0]->{weak_ref}        }
 sub init_arg        { $_[0]->{init_arg}        }
 sub type_constraint { $_[0]->{type_constraint} }
 
+sub has_name            { exists $_[0]->{name}            }
+sub has_class           { exists $_[0]->{class}           }
+sub has_default         { exists $_[0]->{default}         }
+sub has_predicate       { exists $_[0]->{predicate}       }
+sub has_clearer         { exists $_[0]->{clearer}         }
+sub has_handles         { exists $_[0]->{handles}         }
+sub has_weak_ref        { exists $_[0]->{weak_ref}        }
+sub has_init_arg        { exists $_[0]->{init_arg}        }
+sub has_type_constraint { exists $_[0]->{type_constraint} }
+
 sub generate_accessor {
     my $attribute = shift;
 
@@ -34,15 +44,7 @@ sub generate_accessor {
     my $default    = $attribute->{default};
     my $trigger    = $attribute->{trigger};
     my $type       = $attribute->{type_constraint};
-
-    my $constraint = sub {
-        return unless $type;
-
-        my $checker = Mouse::TypeRegistry->optimized_constraints->{$type};
-        return $checker if $checker;
-
-        confess "Unable to parse type constraint '$type'";
-    }->();
+    my $constraint = $attribute->find_type_constraint;
 
     my $accessor = 'sub {
         my $self = shift;';
@@ -177,6 +179,33 @@ sub create {
     return $attribute;
 }
 
+sub find_type_constraint {
+    my $self = shift;
+    my $type = $self->type_constraint;
+
+    return unless $type;
+
+    my $checker = Mouse::TypeRegistry->optimized_constraints->{$type};
+    return $checker if $checker;
+
+    confess "Unable to parse type constraint '$type'";
+}
+
+sub verify_type_constraint {
+    my $self = shift;
+    local $_ = shift;
+
+    my $type = $self->type_constraint
+        or return 1;
+    my $constraint = $self->find_type_constraint
+        or return 1;
+
+    return 1 if $constraint->($_);
+
+    my $name = $self->name;
+    Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $_");
+}
+
 1;
 
 __END__