1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More; 7use Test::Moose; 8 9use Bread::Board; 10 11{ 12 package Stapler; 13 use Moose; 14 15 package Desk; 16 use Moose; 17 18 package Chair; 19 use Moose; 20 21 package Cubicle; 22 use Moose; 23 24 has 'desk' => ( 25 is => 'ro', 26 isa => 'Desk', 27 required => 1, 28 ); 29 30 has 'chair' => ( 31 is => 'ro', 32 isa => 'Chair', 33 required => 1, 34 ); 35 36 package KeyCard; 37 use Moose; 38 use Moose::Util::TypeConstraints; 39 40 subtype 'KeyCardUUID' => as 'Str'; 41 42 has 'uuid' => ( 43 is => 'ro', 44 isa => 'KeyCardUUID', 45 required => 1, 46 ); 47 48 package Employee; 49 use Moose; 50 51 has [ 'first_name', 'last_name' ] => ( 52 is => 'ro', 53 isa => 'Str', 54 required => 1, 55 ); 56 57 has 'stapler' => ( 58 is => 'ro', 59 isa => 'Stapler', 60 predicate => 'has_stapler' 61 ); 62 63 has 'keycard' => ( 64 is => 'ro', 65 isa => 'KeyCard', 66 required => 1, 67 ); 68 69 has 'work_area' => ( 70 is => 'ro', 71 isa => 'Cubicle', 72 required => 1, 73 ); 74} 75 76my $UUID = 0; 77 78my $c = container 'Initech' => as { 79 80 service 'keycard_uuid_generator' => ( 81 block => sub { ++$UUID } 82 ); 83 84 typemap 'KeyCardUUID' => 'keycard_uuid_generator'; 85 typemap 'Employee' => infer; 86}; 87 88my $micheal = $c->resolve( 89 type => 'Employee', 90 parameters => { 91 first_name => 'Micheal', 92 last_name => 'Bolton' 93 } 94); 95 96my $samir = $c->resolve( 97 type => 'Employee', 98 parameters => { 99 first_name => 'Samir', 100 last_name => 'Nagheenanajar' 101 } 102); 103 104isa_ok($micheal, 'Employee'); 105is($micheal->first_name, 'Micheal', '... got the right first name'); 106is($micheal->last_name, 'Bolton', '... got the right last name'); 107isa_ok($micheal->work_area, 'Cubicle'); 108isa_ok($micheal->work_area->desk, 'Desk'); 109isa_ok($micheal->work_area->chair, 'Chair'); 110ok(!$micheal->has_stapler, '... Micheal doesnt have a stapler'); 111 112isa_ok($samir, 'Employee'); 113is($samir->first_name, 'Samir', '... got the right first name'); 114is($samir->last_name, 'Nagheenanajar', '... got the right last name'); 115isa_ok($samir->work_area, 'Cubicle'); 116isa_ok($samir->work_area->desk, 'Desk'); 117isa_ok($samir->work_area->chair, 'Chair'); 118ok(!$samir->has_stapler, '... Samir doesnt have a stapler'); 119 120isnt($micheal, $samir, '... two different employees'); 121isnt($micheal->work_area, $samir->work_area, '... two different work_areas'); 122isnt($micheal->work_area->chair, $samir->work_area->chair, '... two different work_area chairs'); 123isnt($micheal->work_area->desk, $samir->work_area->desk, '... two different work_area desks'); 124isnt($micheal->keycard, $samir->keycard, '... two different keycards'); 125isnt($micheal->keycard->uuid, $samir->keycard->uuid, '... two different keycard uuids'); 126 127my $milton = $c->resolve( 128 type => 'Employee', 129 parameters => { 130 first_name => 'Milton', 131 last_name => 'Waddams', 132 stapler => Stapler->new 133 } 134); 135 136isa_ok($milton, 'Employee'); 137is($milton->first_name, 'Milton', '... got the right first name'); 138is($milton->last_name, 'Waddams', '... got the right last name'); 139isa_ok($milton->work_area, 'Cubicle'); 140isa_ok($milton->work_area->desk, 'Desk'); 141isa_ok($milton->work_area->chair, 'Chair'); 142ok($milton->has_stapler, '... Milton does have a stapler'); 143 144foreach ( $micheal, $samir ) { 145 isnt($milton, $_, '... two different employees'); 146 isnt($milton->work_area, $_->work_area, '... two different work_areas'); 147 isnt($milton->work_area->chair, $_->work_area->chair, '... two different work_area chairs'); 148 isnt($milton->work_area->desk, $_->work_area->desk, '... two different work_area desks'); 149 isnt($milton->keycard, $_->keycard, '... two different keycards'); 150 isnt($milton->keycard->uuid, $_->keycard->uuid, '... two different keycard uuids'); 151} 152 153done_testing; 154