X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=4c248501b1835ca425f0adf52174db5a30231438;hb=926290ac173b77f0ff0027dcbd95277c9cc2be54;hp=d3eaa3c027e73c53eb4978e4e1e1ac3eea5af48e;hpb=0449307510ab4425a6b340fee9bf85824eb994b1;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index d3eaa3c..4c24850 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -31,8 +31,12 @@ sub _process_options{
     my $can_be_required = defined( $args->{init_arg} );
 
     if(exists $args->{builder}){
+        # XXX:
+        # Moose refuses a CODE ref builder, but Mouse doesn't for backward compatibility
+        # This feature will be changed in a future. (gfx)
         $class->throw_error('builder must be a defined scalar value which is a method name')
-            if ref $args->{builder} || !(defined $args->{builder});
+            #if ref $args->{builder} || !defined $args->{builder};
+            if !defined $args->{builder};
 
         $can_be_required++;
     }
@@ -138,11 +142,11 @@ sub new {
 
     $args{name} = $name;
 
-    my $instance = bless \%args, $class;
+    my $self = bless \%args, $class;
 
     # extra attributes
     if($class ne __PACKAGE__){
-        $class->meta->_initialize_instance($instance,\%args);
+        $class->meta->_initialize_object($self, \%args);
     }
 
 # XXX: there is no fast way to check attribute validity
@@ -152,7 +156,7 @@ sub new {
 #        Carp::cluck("Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad");
 #    }
 
-    return $instance
+    return $self;
 }
 
 # readers
@@ -261,15 +265,32 @@ sub create {
     return $self;
 }
 
+sub _coerce_and_verify {
+    my($self, $value, $instance) = @_;
+
+    my $type_constraint = $self->{type_constraint};
+
+    return $value if !$type_constraint;
+
+    if ($self->should_coerce && $type_constraint->has_coercion) {
+        $value = $type_constraint->coerce($value);
+    }
+
+    return $value if $type_constraint->check($value);
+
+    $self->verify_against_type_constraint($value);
+
+    return $value;
+}
+
 sub verify_against_type_constraint {
     my ($self, $value) = @_;
-    my $tc = $self->type_constraint;
-    return 1 unless $tc;
 
-    local $_ = $value;
-    return 1 if $tc->check($value);
+    my $type_constraint = $self->{type_constraint};
+    return 1 if !$type_constraint;;
+    return 1 if $type_constraint->check($value);
 
-    $self->verify_type_constraint_error($self->name, $value, $tc);
+    $self->verify_type_constraint_error($self->name, $value, $type_constraint);
 }
 
 sub verify_type_constraint_error {
@@ -280,6 +301,9 @@ sub verify_type_constraint_error {
 sub coerce_constraint { ## my($self, $value) = @_;
     my $type = $_[0]->{type_constraint}
         or return $_[1];
+
+    Carp::cluck("coerce_constraint() has been deprecated, which was an internal utility anyway");
+
     return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $type, $_[1]);
 }
 
@@ -374,7 +398,7 @@ __END__
 
 =head1 NAME
 
-Mouse::Meta::Attribute - attribute metaclass
+Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 METHODS
 
@@ -482,6 +506,13 @@ is equivalent to this:
 
 =back
 
+=head2 C<< associate_method(Method) >>
+
+Associates a method with the attribute. Typically, this is called internally
+when an attribute generates its accessors.
+
+Currently the argument I<Method> is ignored in Mouse.
+
 =head2 C<< verify_against_type_constraint(Item) -> TRUE | ERROR >>
 
 Checks that the given value passes this attribute's type constraint. Returns C<true>
@@ -496,5 +527,7 @@ Accessors and helper methods are installed. Some error checking is done.
 
 L<Moose::Meta::Attribute>
 
+L<Class::MOP::Attribute>
+
 =cut