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