X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=313c9f3c7d3a7e300b60fe4dd75134d854be1ae6;hb=7dbda4584d3c2914caf32515d4ce9621f94a819e;hp=fa3db88ef5d2a78cd83c8f957067790b6f61c7f9;hpb=8abe9636abcd0945739dfeaf971eddbe1fd0cc9e;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index fa3db88..313c9f3 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -9,7 +9,7 @@ use Carp         'confess';
 use Sub::Name    'subname';
 use overload     ();
 
-our $VERSION   = '0.20';
+our $VERSION   = '0.22';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -47,6 +47,14 @@ __PACKAGE__->meta->add_attribute('documentation' => (
     predicate => 'has_documentation',
 ));
 
+# NOTE:
+# we need to have a ->does method in here to 
+# more easily support traits, and the introspection 
+# of those traits. So in order to do this we 
+# just alias Moose::Object's version of it.
+# - SL
+*does = \&Moose::Object::does;
+
 sub new {
     my ($class, $name, %options) = @_;
     $class->_process_options($name, \%options);
@@ -57,23 +65,13 @@ sub clone_and_inherit_options {
     my ($self, %options) = @_;
     # you can change default, required, coerce, documentation and lazy
     my %actual_options;
-    foreach my $legal_option (qw(default coerce required documentation lazy)) {
+    foreach my $legal_option (qw(default coerce required documentation lazy handles builder)) {
         if (exists $options{$legal_option}) {
             $actual_options{$legal_option} = $options{$legal_option};
             delete $options{$legal_option};
         }
     }
 
-    # handles can only be added, not changed
-    if ($options{handles}) {
-        confess "You can only add the 'handles' option, you cannot change it"
-            if $self->has_handles;
-        $actual_options{handles} = $options{handles};
-        delete $options{handles};
-    }
-
-    # isa can be changed, but only if the
-    # new type is a subtype
     if ($options{isa}) {
         my $type_constraint;
         if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
@@ -86,14 +84,7 @@ sub clone_and_inherit_options {
             (defined $type_constraint)
                 || confess "Could not find the type constraint '" . $options{isa} . "'";
         }
-        # NOTE:
-        # check here to see if the new type
-        # is a subtype of the old one
-        ($type_constraint->is_subtype_of($self->type_constraint->name))
-            || confess "New type constraint setting must be a subtype of inherited one"
-                # iff we have a type constraint that is ...
-                if $self->has_type_constraint;
-        # then we use it :)
+
         $actual_options{type_constraint} = $type_constraint;
         delete $options{isa};
     }
@@ -109,7 +100,7 @@ sub _process_options {
         if ($options->{is} eq 'ro') {
             $options->{reader} ||= $name;
             (!exists $options->{trigger})
-                || confess "Cannot have a trigger on a read-only attribute";
+                || confess "Cannot have a trigger on a read-only attribute $name";
         }
         elsif ($options->{is} eq 'rw') {
             $options->{accessor} = $name;
@@ -118,7 +109,7 @@ sub _process_options {
                     if exists $options->{trigger};
         }
         else {
-            confess "I do not understand this option (is => " . $options->{is} . ")"
+            confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name"
         }
     }
 
@@ -126,10 +117,10 @@ sub _process_options {
         if (exists $options->{does}) {
             if (eval { $options->{isa}->can('does') }) {
                 ($options->{isa}->does($options->{does}))
-                    || confess "Cannot have an isa option and a does option if the isa does not do the does";
+                    || confess "Cannot have an isa option and a does option if the isa does not do the does on attribute $name";
             }
             else {
-                confess "Cannot have an isa option which cannot ->does()";
+                confess "Cannot have an isa option which cannot ->does() on attribute $name";
             }
         }
 
@@ -165,21 +156,21 @@ sub _process_options {
 
     if (exists $options->{coerce} && $options->{coerce}) {
         (exists $options->{type_constraint})
-            || confess "You cannot have coercion without specifying a type constraint";
-        confess "You cannot have a weak reference to a coerced value"
+            || confess "You cannot have coercion without specifying a type constraint on attribute $name";
+        confess "You cannot have a weak reference to a coerced value on attribute $name"
             if $options->{weak_ref};
     }
 
     if (exists $options->{auto_deref} && $options->{auto_deref}) {
         (exists $options->{type_constraint})
-            || confess "You cannot auto-dereference without specifying a type constraint";
+            || confess "You cannot auto-dereference without specifying a type constraint on attribute $name";
         ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
          $options->{type_constraint}->is_a_type_of('HashRef'))
-            || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef";
+            || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name";
     }
 
     if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
-        confess("You can not use lazy_build and default for the same attribute")
+        confess("You can not use lazy_build and default for the same attribute $name")
             if exists $options->{default};
         $options->{lazy}      = 1;
         $options->{required}  = 1;
@@ -196,11 +187,11 @@ sub _process_options {
 
     if (exists $options->{lazy} && $options->{lazy}) {
         (exists $options->{default} || defined $options->{builder} )
-            || confess "You cannot have lazy attribute without specifying a default value for it";
+            || confess "You cannot have lazy attribute ($name) without specifying a default value for it";
     }
 
     if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) {
-        confess "You cannot have a required attribute without a default, builder, or an init_arg";
+        confess "You cannot have a required attribute ($name) without a default, builder, or an init_arg";
     }
 
 }
@@ -437,13 +428,22 @@ sub install_accessors {
                 $associated_class->add_method($handle => subname $name, $method_to_call);
             }
             else {
+                # NOTE:
+                # we used to do a goto here, but the
+                # goto didn't handle failure correctly
+                # (it just returned nothing), so I took 
+                # that out. However, the more I thought
+                # about it, the less I liked it doing 
+                # the goto, and I prefered the act of 
+                # delegation being actually represented
+                # in the stack trace. 
+                # - SL
                 $associated_class->add_method($handle => subname $name, sub {
                     my $proxy = (shift)->$accessor();
-                    @_ = ($proxy, @_);
                     (defined $proxy) 
                         || confess "Cannot delegate $handle to $method_to_call because " . 
                                    "the value of " . $self->name . " is not defined";
-                    goto &{ $proxy->can($method_to_call) || return };
+                    $proxy->$method_to_call(@_);
                 });
             }
         }
@@ -563,6 +563,8 @@ will behave just as L<Class::MOP::Attribute> does.
 
 =item B<new>
 
+=item B<does>
+
 =item B<initialize_instance_slot>
 
 =item B<install_accessors>