1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More; 7use Test::Moose; 8 9use Bread::Board; 10 11{ # Abstract items ... 12 package Desk; 13 use Moose::Role; 14 15 package Chair; 16 use Moose::Role; 17 18 package WorkArea; 19 use Moose::Role; 20 21 has 'desk' => ( 22 is => 'ro', 23 does => 'Desk', 24 required => 1, 25 ); 26 27 has 'chair' => ( 28 is => 'ro', 29 does => 'Chair', 30 required => 1, 31 ); 32} 33 34# crappy stuff 35{ 36 package CheapMetalDesk; 37 use Moose; 38 with 'Desk'; 39 40 package CheapOfficeChair; 41 use Moose; 42 with 'Chair'; 43 44 package Cubicle; 45 use Moose; 46 with 'WorkArea'; 47} 48 49# good stuff 50{ 51 package NiceWoodenDesk; 52 use Moose; 53 with 'Desk'; 54 55 package AeronChair; 56 use Moose; 57 with 'Chair'; 58 59 package Office; 60 use Moose; 61 with 'WorkArea'; 62} 63 64{ 65 package Employee; 66 use Moose; 67 68 has [ 'first_name', 'last_name' ] => ( 69 is => 'ro', 70 isa => 'Str', 71 required => 1, 72 ); 73 74 has 'work_area' => ( 75 is => 'ro', 76 does => 'WorkArea', 77 required => 1, 78 ); 79 80 package Manager; 81 use Moose; 82 83 extends 'Employee'; 84 85 has '+work_area' => ( isa => 'Office' ); 86} 87 88my $c = container 'Initech' => as { 89 90 # Employees ... 91 typemap 'Desk' => infer( class => 'CheapMetalDesk' ); 92 typemap 'Chair' => infer( class => 'CheapOfficeChair' ); 93 typemap 'WorkArea' => infer( class => 'Cubicle' ); 94 95 # Managers ... 96 service 'managers_desk' => (class => 'NiceWoodenDesk'); 97 service 'managers_chair' => (class => 'AeronChair'); 98 typemap 'Office' => infer( 99 dependencies => { 100 desk => depends_on('managers_desk'), 101 chair => depends_on('managers_chair') 102 } 103 ); 104 105 typemap 'Employee' => infer; 106 typemap 'Manager' => infer; 107}; 108 109my $micheal = $c->resolve( 110 type => 'Employee', 111 parameters => { 112 first_name => 'Micheal', 113 last_name => 'Bolton' 114 } 115); 116my $samir = $c->resolve( 117 type => 'Employee', 118 parameters => { 119 first_name => 'Samir', 120 last_name => 'Nagheenanajar' 121 } 122); 123 124isa_ok($micheal, 'Employee'); 125is($micheal->first_name, 'Micheal', '... got the right first name'); 126is($micheal->last_name, 'Bolton', '... got the right last name'); 127 128does_ok($micheal->work_area, 'WorkArea'); 129isa_ok($micheal->work_area, 'Cubicle'); 130 131does_ok($micheal->work_area->desk, 'Desk'); 132isa_ok($micheal->work_area->desk, 'CheapMetalDesk'); 133 134does_ok($micheal->work_area->chair, 'Chair'); 135isa_ok($micheal->work_area->chair, 'CheapOfficeChair'); 136 137isa_ok($samir, 'Employee'); 138is($samir->first_name, 'Samir', '... got the right first name'); 139is($samir->last_name, 'Nagheenanajar', '... got the right last name'); 140 141does_ok($samir->work_area, 'WorkArea'); 142isa_ok($samir->work_area, 'Cubicle'); 143 144does_ok($samir->work_area->desk, 'Desk'); 145isa_ok($samir->work_area->desk, 'CheapMetalDesk'); 146 147does_ok($samir->work_area->chair, 'Chair'); 148isa_ok($samir->work_area->chair, 'CheapOfficeChair'); 149 150isnt($micheal, $samir, '... two different employees'); 151isnt($micheal->work_area, $samir->work_area, '... two different cubicles'); 152isnt($micheal->work_area->chair, $samir->work_area->chair, '... two different cubicle chairs'); 153isnt($micheal->work_area->desk, $samir->work_area->desk, '... two different cubicle desks'); 154 155# managers 156 157my $lundberg = $c->resolve( 158 type => 'Manager', 159 parameters => { 160 first_name => 'Bill', 161 last_name => 'Lundberg' 162 } 163); 164 165isa_ok($lundberg, 'Manager'); 166is($lundberg->first_name, 'Bill', '... got the right first name'); 167is($lundberg->last_name, 'Lundberg', '... got the right last name'); 168 169does_ok($lundberg->work_area, 'WorkArea'); 170isa_ok($lundberg->work_area, 'Office'); 171 172does_ok($lundberg->work_area->desk, 'Desk'); 173isa_ok($lundberg->work_area->desk, 'NiceWoodenDesk'); 174 175does_ok($lundberg->work_area->chair, 'Chair'); 176isa_ok($lundberg->work_area->chair, 'AeronChair'); 177 178done_testing; 179