From 61839366b807e9e8f6818020508d765efed945b5 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 21 Feb 2011 15:38:37 -0600 Subject: handle attribute overriding better --- lib/MooseX/Bread/Board/Meta/Role/Attribute.pm | 11 ++- lib/MooseX/Bread/Board/Meta/Role/Class.pm | 27 +------ lib/MooseX/Bread/Board/Role/Object.pm | 1 - t/22-more-inheritance.t | 102 ++++++++++++++++++++++++++ 4 files changed, 113 insertions(+), 28 deletions(-) create mode 100644 t/22-more-inheritance.t diff --git a/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm index 52e5a7c..2622e84 100644 --- a/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm +++ b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm @@ -48,14 +48,17 @@ has constructor_name => ( predicate => 'has_constructor_name', ); +has associated_service => ( + is => 'rw', + isa => 'Bread::Board::Service', + predicate => 'has_associated_service', +); + after attach_to_class => sub { my $self = shift; return unless $self->service; - my $meta = $self->associated_class; - my $attr_reader = $self->get_read_method; - my %params = ( associated_attribute => $self, name => $self->name, @@ -93,7 +96,7 @@ after attach_to_class => sub { } } - $meta->add_service($service) if $service; + $self->associated_service($service) if $service; }; after _process_options => sub { diff --git a/lib/MooseX/Bread/Board/Meta/Role/Class.pm b/lib/MooseX/Bread/Board/Meta/Role/Class.pm index e48c9f6..66c18ac 100644 --- a/lib/MooseX/Bread/Board/Meta/Role/Class.pm +++ b/lib/MooseX/Bread/Board/Meta/Role/Class.pm @@ -4,31 +4,12 @@ use Moose::Role; use Bread::Board::Service; use List::MoreUtils qw(any); -has services => ( - traits => ['Array'], - isa => 'ArrayRef[Bread::Board::Service]', - default => sub { [] }, - handles => { - add_service => 'push', - services => 'elements', - has_services => 'count', - }, -); - -sub has_any_services { - my $self = shift; - return any { $_->has_services } - grep { Moose::Util::does_role($_, __PACKAGE__) } - map { $_->meta } - $self->linearized_isa; -} - sub get_all_services { my $self = shift; - return map { $_->services } - grep { Moose::Util::does_role($_, __PACKAGE__) } - map { $_->meta } - $self->linearized_isa; + return map { $_->associated_service } + grep { $_->has_associated_service } + grep { Moose::Util::does_role($_, 'MooseX::Bread::Board::Meta::Role::Attribute') } + $self->get_all_attributes; } before superclasses => sub { diff --git a/lib/MooseX/Bread/Board/Role/Object.pm b/lib/MooseX/Bread/Board/Role/Object.pm index 6eaf87d..e99e5ed 100644 --- a/lib/MooseX/Bread/Board/Role/Object.pm +++ b/lib/MooseX/Bread/Board/Role/Object.pm @@ -13,7 +13,6 @@ after BUILD => sub { my $self = shift; my $meta = Class::MOP::class_of($self); - return unless $meta->has_any_services; for my $service ($meta->get_all_services) { if ($service->isa('MooseX::Bread::Board::BlockInjection')) { diff --git a/t/22-more-inheritance.t b/t/22-more-inheritance.t new file mode 100644 index 0000000..b32a7d1 --- /dev/null +++ b/t/22-more-inheritance.t @@ -0,0 +1,102 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +{ + package Parent; + use Moose; + use MooseX::Bread::Board; + + has foo => ( + is => 'ro', + isa => 'Str', + value => 'parent', + ); + + has bar => ( + is => 'ro', + isa => 'Str', + block => sub { + my $s = shift; + return $s->param('foo') . ' ' . 'parent'; + }, + dependencies => ['foo'], + ); +} + +{ + package Child1; + use Moose; + use MooseX::Bread::Board; + + extends 'Parent'; + + has foo => ( + is => 'ro', + isa => 'Str', + value => 'child', + ); +} + +{ + package Child2; + use Moose; + use MooseX::Bread::Board; + + extends 'Parent'; + + has bar => ( + is => 'ro', + isa => 'Str', + block => sub { + my $s = shift; + return $s->param('foo') . ' ' . 'child'; + }, + dependencies => ['foo'], + ); +} + +{ + package Child3; + use Moose; + use MooseX::Bread::Board; + + extends 'Child1'; + + has bar => ( + is => 'ro', + isa => 'Str', + block => sub { + my $s = shift; + return $s->param('foo') . ' ' . 'child'; + }, + dependencies => ['foo'], + ); +} + +{ + my $obj = Parent->new; + is($obj->foo, 'parent'); + is($obj->bar, 'parent parent'); +} + +{ + my $obj = Child1->new; + is($obj->foo, 'child'); + is($obj->bar, 'child parent'); +} + +{ + my $obj = Child2->new; + is($obj->foo, 'parent'); + is($obj->bar, 'parent child'); +} + +{ + my $obj = Child3->new; + is($obj->foo, 'child'); + is($obj->bar, 'child child'); +} + +done_testing; -- cgit v1.2.3-54-g00ecf