From: Shawn M Moore Date: Sun, 15 Jun 2008 18:35:14 +0000 (+0000) Subject: Begin adding support for has +name X-Git-Tag: 0.04~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1bfebf5f59ec3d3b5624f3d3a186506150f08ed2;p=gitmo%2FMouse.git Begin adding support for has +name --- diff --git a/Changes b/Changes index 3abe605..6fddc92 100644 --- 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 --- 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 --- 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__