Begin adding support for has +name

diff --git a/Changes b/Changes
index 3abe605..6fddc92 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,29 +1,32 @@
 Revision history for Mouse
 
 0.04
+    * Mouse
+      Mouse::Meta::Attribute
+      - Add support for has '+name'
 
 0.03 Thu Jun 12 21:54:07 2008
-     * Mouse:
-       - Add before/after/around, courtesy of Class::Method::Modifiers
+    * Mouse
+      - Add before/after/around, courtesy of Class::Method::Modifiers
 
-     * Mouse::Object:
-       - Add support for ->new({...})
-       - Use compute_all_applicable_attributes in the constructor to get the
-         attributes of superclasses
-       - Add better support for undef init_arg
+    * Mouse::Object
+      - Add support for ->new({...})
+      - Use compute_all_applicable_attributes in the constructor to get the
+        attributes of superclasses
+      - Add better support for undef init_arg
 
-     * Mouse::Meta::Class:
-       - More methods: compute_all_applicable_attributes, has_attribute
+    * Mouse::Meta::Class
+      - More methods: compute_all_applicable_attributes, has_attribute
 
 0.02 Wed Jun 11 01:56:44 2008
-     * Squirrel:
-       - Add Squirrel which acts as Moose if it's already loaded, otherwise
-         Mouse (thanks nothingmuch)
+    * Squirrel
+      - Add Squirrel which acts as Moose if it's already loaded, otherwise
+        Mouse (thanks nothingmuch)
 
-     * Mouse::Meta::Object:
-       - Fix the order in which BUILD methods are called (thanks Robert
-         Boone)
+    * Mouse::Meta::Object
+      - Fix the order in which BUILD methods are called (thanks Robert
+        Boone)
 
 0.01 Tue Jun 10 02:13:21 2008
-     * Initial release.
+    * Initial release.
 

diff --git a/lib/Mouse.pm b/lib/Mouse.pm
index 2e71b9f..22d8b2d 100644 (file)
--- a/lib/Mouse.pm
+++ b/lib/Mouse.pm
@@ -39,7 +39,12 @@ do {
                 $names = [$names] if !ref($names);
 
                 for my $name (@$names) {
-                    Mouse::Meta::Attribute->create($package, $name, @_);
+                    if ($name =~ s/^\+//) {
+                        Mouse::Meta::Attribute->clone_parent($package, $name, @_);
+                    }
+                    else {
+                        Mouse::Meta::Attribute->create($package, $name, @_);
+                    }
                 }
             };
         },

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 42a212b..ff1a3ff 100644 (file)
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -41,6 +41,11 @@ sub has_type_constraint { exists $_[0]->{type_constraint} }
 sub has_trigger         { exists $_[0]->{trigger}         }
 sub has_builder         { exists $_[0]->{builder}         }
 
+sub _create_args {
+    $_[0]->{_create_args} = $_[1] if @_ > 1;
+    $_[0]->{_create_args}
+}
+
 sub generate_accessor {
     my $attribute = shift;
 
@@ -155,12 +160,17 @@ sub generate_handles {
 sub create {
     my ($self, $class, $name, %args) = @_;
 
+    $args{name} = $name;
+    $args{class} = $class;
+
     $self->validate_args($name, %args);
 
     $args{type_constraint} = delete $args{isa}
         if exists $args{isa};
 
-    my $attribute = $self->new(%args, name => $name, class => $class);
+    my $attribute = $self->new(%args);
+    $attribute->_create_args(\%args);
+
     my $meta = $class->meta;
 
     $meta->add_attribute($attribute);
@@ -258,6 +268,29 @@ sub _canonicalize_handles {
     }
 }
 
+sub clone_parent {
+    my $self  = shift;
+    my $class = shift;
+    my $name  = shift;
+    my %args  = ($self->get_parent_args($class, $name), @_);
+
+    $self->create($class, $name, %args);
+}
+
+sub get_parent_args {
+    my $self  = shift;
+    my $class = shift;
+    my $name  = shift;
+
+    for my $super ($class->meta->linearized_isa) {
+        my $super_attr = $super->meta->get_attribute($name)
+            or next;
+        return %{ $super_attr->_create_args };
+    }
+
+    confess "Could not find an attribute by the name of '$name' to inherit from";
+}
+
 1;
 
 __END__