From 611559725cf480ba49616ee29f5231b9f9bb2a05 Mon Sep 17 00:00:00 2001 From: Caleb Cushing Date: Fri, 1 Nov 2013 08:50:23 -0500 Subject: [PATCH 1/2] add roles when using constructor injection Bread::Board::ConstructorInjection->new( class => 'Foo', roles => ['Bar'], ) the benefit of this is to allow us to modify classes, that we may not have control over modifying the source of, at runtime. Signed-off-by: Caleb Cushing --- lib/Bread/Board/ConstructorInjection.pm | 3 +- lib/Bread/Board/Service/WithRoles.pm | 34 +++++++++++++ t/006_constructor_injection_w_roles.t | 67 +++++++++++++++++++++++++ 3 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 lib/Bread/Board/Service/WithRoles.pm create mode 100644 t/006_constructor_injection_w_roles.t diff --git a/lib/Bread/Board/ConstructorInjection.pm b/lib/Bread/Board/ConstructorInjection.pm index 689cfd4..004c8f3 100644 --- a/lib/Bread/Board/ConstructorInjection.pm +++ b/lib/Bread/Board/ConstructorInjection.pm @@ -7,7 +7,8 @@ use Bread::Board::Types; with 'Bread::Board::Service::WithClass', 'Bread::Board::Service::WithParameters', - 'Bread::Board::Service::WithDependencies'; + 'Bread::Board::Service::WithDependencies', + 'Bread::Board::Service::WithRoles'; has 'constructor_name' => ( is => 'rw', diff --git a/lib/Bread/Board/Service/WithRoles.pm b/lib/Bread/Board/Service/WithRoles.pm new file mode 100644 index 0000000..09631d3 --- /dev/null +++ b/lib/Bread/Board/Service/WithRoles.pm @@ -0,0 +1,34 @@ +package Bread::Board::Service::WithRoles; +use Moose::Role; + +use Bread::Board::Types; + +with 'Bread::Board::Service'; + +has 'roles' => ( + is => 'rw', + isa => 'ArrayRef[Str]', + traits => ['Array'], + lazy => 1, + default => sub { +[] }, + handles => { + has_roles => 'count', + list_roles => 'elements', + }, +); + +before 'get' => sub { + my $self = shift; + + if ( $self->has_roles ) { + + foreach my $role ( $self->list_roles ) { + Module::Runtime::use_package_optimistically( $role ); + } + my $class = Moose::Util::with_traits( $self->class, $self->list_roles ); + $class->meta->make_immutable if $self->has_roles; + $self->class( $class ); + } +}; + +no Moose::Role; 1; diff --git a/t/006_constructor_injection_w_roles.t b/t/006_constructor_injection_w_roles.t new file mode 100644 index 0000000..f0b4936 --- /dev/null +++ b/t/006_constructor_injection_w_roles.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Moose; +use Test::Fatal; + +use Bread::Board::ConstructorInjection; +use Bread::Board::Literal; + +{ + package Sterile; + use Moose::Role; + + package Needle; + use Moose; + + package Mexican::Black::Tar; + use Moose; + + package Addict; + use Moose; + + sub shoot_up_good { shift->new(@_, overdose => 1) } + + has 'needle' => (is => 'ro'); + has 'spoon' => (is => 'ro'); + has 'stash' => (is => 'ro'); + has 'overdose' => (is => 'ro', isa => 'Bool', default => 0); +} + +my $s = Bread::Board::ConstructorInjection->new( + name => 'William', + class => 'Addict', + dependencies => { + needle => Bread::Board::ConstructorInjection->new( + name => 'spike', + class => 'Needle', + roles => ['Sterile'], # I need sterile needle's yo + ), + spoon => Bread::Board::Literal->new(name => 'works', value => 'Spoon!'), + }, + parameters => { + stash => { isa => 'Mexican::Black::Tar' } + } +); +isa_ok($s, 'Bread::Board::ConstructorInjection'); +does_ok($s, 'Bread::Board::Service::WithClass'); +does_ok($s, 'Bread::Board::Service::WithDependencies'); +does_ok($s, 'Bread::Board::Service::WithParameters'); +does_ok($s, 'Bread::Board::Service'); + +{ + my $i = $s->get(stash => Mexican::Black::Tar->new); + + isa_ok($i, 'Addict'); + isa_ok($i->needle, 'Needle'); + does_ok( $i->needle, 'Sterile' ); + ok( $i->needle->meta->is_immutable, 'is immutable' ); + is($i->spoon, 'Spoon!', '... got our literal service'); + isa_ok($i->stash, 'Mexican::Black::Tar'); + ok ! $i->overdose, 'Normal constructor'; +} + +done_testing; From 661d0ee37caa8d66a4115f600fcf11c6f293eba2 Mon Sep 17 00:00:00 2001 From: Caleb Cushing Date: Sat, 14 Dec 2013 05:37:47 -0600 Subject: [PATCH 2/2] add failing test Signed-off-by: Caleb Cushing --- t/081_infer_w_roles.t | 91 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 t/081_infer_w_roles.t diff --git a/t/081_infer_w_roles.t b/t/081_infer_w_roles.t new file mode 100644 index 0000000..e3abad2 --- /dev/null +++ b/t/081_infer_w_roles.t @@ -0,0 +1,91 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Bread::Board; + +{ + package NonMoose; + sub new { bless { data => $_[0] }, shift } +} + +{ + package Foo; + use Moose; +} + +{ + package Bar; + use Moose; + + has foo => ( + is => 'ro', + isa => 'Foo', + required => 1, + ); +} + +{ + package NotMoosey; + use Moose::Role; + + has non_moose => ( + is => 'ro', + isa => 'NonMoose', + required => 1, + ); +} + +{ + package Bar; + use Moose; + + has foo => ( + is => 'ro', + isa => 'Foo', + required => 1, + ); +} + +{ + my $c = container Stuff => as { + service non_moose => NonMoose->new("foo"); + service foo => ( + class => 'Foo', + roles => ['NotMoosey'] + ); + typemap 'Foo' => 'foo'; + typemap 'Bar' => infer; + }; + + my $bar = $c->resolve(type => 'Bar'); + isa_ok($bar->foo->non_moose, 'NonMoose'); +} + +done_testing; +__END__ + +{ + package Foo::Sub; + use Moose; + + extends 'Foo'; +} + +{ + my $c = container Stuff => as { + service non_moose => NonMoose->new("foo"); + service foo => ( + class => 'Foo::Sub', + dependencies => ['non_moose'], + ); + typemap 'Foo::Sub' => 'foo'; + typemap 'Bar' => infer; + }; + + my $bar = $c->resolve(type => 'Bar'); + isa_ok($bar->foo->non_moose, 'NonMoose'); +} + +done_testing;