X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=dffcb227d903a45e19e950a1d29a361cfb95651f;hb=e763d56e2b18480328a95cbbe9e9b58988a8c4dc;hp=7d6d68e040d6af80a36c2b8e7d341a83b7375c6e;hpb=7ca5c5fb6e084d9c57bc022b336458afc74c6847;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 7d6d68e..dffcb22 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -12,6 +12,12 @@ use Mouse::Meta::Method::Accessor;
 sub _process_options{
     my($class, $name, $args) = @_;
 
+
+    # XXX: for backward compatibility (with method modifiers)
+    if($class->can('canonicalize_args') != \&canonicalize_args){
+        %{$args} = $class->canonicalize_args($name, %{$args});
+    }
+
     # taken from Class::MOP::Attribute::new
 
     defined($name)
@@ -25,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++;
     }
@@ -72,7 +82,8 @@ sub _process_options{
         $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($args->{isa});
     }
     elsif(exists $args->{does}){
-        $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_does_type_constraint($args->{does});
+        # TODO
+        # $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_does_type_constraint($args->{does});
     }
     $tc = $args->{type_constraint};
 
@@ -118,10 +129,6 @@ sub _process_options{
             || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it");
     }
 
-    # XXX: for backward compatibility (with method modifiers)
-    if($class->can('canonicalize_args') != \&canonicalize_args){
-        %{$args} = $class->canonicalize_args($name, %{$args});
-    }
     return;
 }
 
@@ -149,7 +156,7 @@ sub new {
 #        Carp::cluck("Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad");
 #    }
 
-    return $instance
+    return $instance;
 }
 
 # readers
@@ -241,7 +248,8 @@ sub canonicalize_args{
     my ($self, $name, %args) = @_;
 
     Carp::cluck("$self->canonicalize_args has been deprecated."
-        . "Use \$self->_process_options instead.");
+        . "Use \$self->_process_options instead.")
+            if _MOUSE_VERBOSE;
 
     return %args;
 }
@@ -250,21 +258,39 @@ sub create {
     my ($self, $class, $name, %args) = @_;
 
     Carp::cluck("$self->create has been deprecated."
-        . "Use \$meta->add_attribute and \$attr->install_accessors instead.");
+        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
+            if _MOUSE_VERBOSE;
 
     # noop
     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 {
@@ -275,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]);
 }
 
@@ -307,8 +336,8 @@ sub clone_parent {
     my %args  = ($self->get_parent_args($class, $name), @_);
 
     Carp::cluck("$self->clone_parent has been deprecated."
-        . "Use \$meta->add_attribute and \$attr->install_accessors instead.");
-
+        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
+        if _MOUSE_VERBOSE;
 
     $self->clone_and_inherited_args($class, $name, %args);
 }
@@ -327,6 +356,12 @@ sub get_parent_args {
     $self->throw_error("Could not find an attribute by the name of '$name' to inherit from");
 }
 
+sub associate_method{
+    my ($attribute, $method) = @_;
+    $attribute->{associated_methods}++;
+    return;
+}
+
 sub install_accessors{
     my($attribute) = @_;
 
@@ -363,7 +398,7 @@ __END__
 
 =head1 NAME
 
-Mouse::Meta::Attribute - attribute metaclass
+Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 METHODS
 
@@ -375,7 +410,7 @@ It adds the following options to the constructor:
 
 =over 4
 
-=item * C<< is => 'ro', 'rw', 'bare' >>
+=item C<< is => 'ro', 'rw', 'bare' >>
 
 This provides a shorthand for specifying the C<reader>, C<writer>, or
 C<accessor> names. If the attribute is read-only ('ro') then it will
@@ -391,7 +426,7 @@ Use 'bare' when you are deliberately not installing any methods
 Moose will issue a deprecation warning when this attribute is added to a
 metaclass.
 
-=item * C<< isa => Type >>
+=item C<< isa => Type >>
 
 This option accepts a type. The type can be a string, which should be
 a type name. If the type name is unknown, it is assumed to be a class
@@ -403,14 +438,14 @@ If you I<also> provide a C<does> option, then your C<isa> option must
 be a class name, and that class must do the role specified with
 C<does>.
 
-=item * C<< does => Role >>
+=item C<< does => Role >>
 
 This is short-hand for saying that the attribute's type must be an
 object which does the named role.
 
 B<This option is not yet supported.>
 
-=item * C<< coerce => Bool >>
+=item C<< coerce => Bool >>
 
 This option is only valid for objects with a type constraint
 (C<isa>). If this is true, then coercions will be applied whenever
@@ -418,12 +453,12 @@ this attribute is set.
 
 You can make both this and the C<weak_ref> option true.
 
-=item * C<< trigger => CodeRef >>
+=item C<< trigger => CodeRef >>
 
 This option accepts a subroutine reference, which will be called after
 the attribute is set.
 
-=item * C<< required => Bool >>
+=item C<< required => Bool >>
 
 An attribute which is required must be provided to the constructor. An
 attribute which is required can also have a C<default> or C<builder>,
@@ -432,24 +467,24 @@ which will satisfy its required-ness.
 A required attribute must have a C<default>, C<builder> or a
 non-C<undef> C<init_arg>
 
-=item * C<< lazy => Bool >>
+=item C<< lazy => Bool >>
 
 A lazy attribute must have a C<default> or C<builder>. When an
 attribute is lazy, the default value will not be calculated until the
 attribute is read.
 
-=item * C<< weak_ref => Bool >>
+=item C<< weak_ref => Bool >>
 
 If this is true, the attribute's value will be stored as a weak
 reference.
 
-=item * C<< auto_deref => Bool >>
+=item C<< auto_deref => Bool >>
 
 If this is true, then the reader will dereference the value when it is
 called. The attribute must have a type constraint which defines the
 attribute as an array or hash reference.
 
-=item * C<< lazy_build => Bool >>
+=item C<< lazy_build => Bool >>
 
 Setting this to true makes the attribute lazy and provides a number of
 default methods.
@@ -471,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>
@@ -478,12 +520,14 @@ on success, otherwise C<confess>es.
 
 =head2 C<< clone_and_inherit_options(options) -> Mouse::Meta::Attribute >>
 
-Creates a new attribute in OwnerClass, inheriting options from parent classes.
+Creates a new attribute in the owner class, inheriting options from parent classes.
 Accessors and helper methods are installed. Some error checking is done.
 
 =head1 SEE ALSO
 
 L<Moose::Meta::Attribute>
 
+L<Class::MOP::Attribute>
+
 =cut