076_more_complex_typemap.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Moose;

use Bread::Board;

{
    package Stapler;
    use Moose;

    package Desk;
    use Moose;

    package Chair;
    use Moose;

    package Cubicle;
    use Moose;

    has 'desk' => (
        is       => 'ro',
        isa      => 'Desk',
        required => 1,
    );

    has 'chair' => (
        is       => 'ro',
        isa      => 'Chair',
        required => 1,
    );

    package KeyCard;
    use Moose;
    use Moose::Util::TypeConstraints;

    subtype 'KeyCardUUID' => as 'Str';

    has 'uuid' => (
        is       => 'ro',
        isa      => 'KeyCardUUID',
        required => 1,
    );

    package Employee;
    use Moose;

    has [ 'first_name', 'last_name' ] => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );

    has 'stapler' => (
        is        => 'ro',
        isa       => 'Stapler',
        predicate => 'has_stapler'
    );

    has 'keycard' => (
        is       => 'ro',
        isa      => 'KeyCard',
        required => 1,
    );

    has 'work_area' => (
        is       => 'ro',
        isa      => 'Cubicle',
        required => 1,
    );
}

my $UUID = 0;

my $c = container 'Initech' => as {

    service 'keycard_uuid_generator' => (
        block => sub { ++$UUID }
    );

    typemap 'KeyCardUUID' => 'keycard_uuid_generator';
    typemap 'Employee'    => infer;
};

my $micheal = $c->resolve(
    type       => 'Employee',
    parameters => {
        first_name => 'Micheal',
        last_name  => 'Bolton'
    }
);

my $samir = $c->resolve(
    type       => 'Employee',
    parameters => {
        first_name => 'Samir',
        last_name  => 'Nagheenanajar'
    }
);

isa_ok($micheal, 'Employee');
is($micheal->first_name, 'Micheal', '... got the right first name');
is($micheal->last_name, 'Bolton', '... got the right last name');
isa_ok($micheal->work_area, 'Cubicle');
isa_ok($micheal->work_area->desk, 'Desk');
isa_ok($micheal->work_area->chair, 'Chair');
ok(!$micheal->has_stapler, '... Micheal doesnt have a stapler');

isa_ok($samir, 'Employee');
is($samir->first_name, 'Samir', '... got the right first name');
is($samir->last_name, 'Nagheenanajar', '... got the right last name');
isa_ok($samir->work_area, 'Cubicle');
isa_ok($samir->work_area->desk, 'Desk');
isa_ok($samir->work_area->chair, 'Chair');
ok(!$samir->has_stapler, '... Samir doesnt have a stapler');

isnt($micheal, $samir, '... two different employees');
isnt($micheal->work_area, $samir->work_area, '... two different work_areas');
isnt($micheal->work_area->chair, $samir->work_area->chair, '... two different work_area chairs');
isnt($micheal->work_area->desk, $samir->work_area->desk, '... two different work_area desks');
isnt($micheal->keycard, $samir->keycard, '... two different keycards');
isnt($micheal->keycard->uuid, $samir->keycard->uuid, '... two different keycard uuids');

my $milton = $c->resolve(
    type       => 'Employee',
    parameters => {
        first_name => 'Milton',
        last_name  => 'Waddams',
        stapler    => Stapler->new
    }
);

isa_ok($milton, 'Employee');
is($milton->first_name, 'Milton', '... got the right first name');
is($milton->last_name, 'Waddams', '... got the right last name');
isa_ok($milton->work_area, 'Cubicle');
isa_ok($milton->work_area->desk, 'Desk');
isa_ok($milton->work_area->chair, 'Chair');
ok($milton->has_stapler, '... Milton does have a stapler');

foreach ( $micheal, $samir ) {
    isnt($milton, $_, '... two different employees');
    isnt($milton->work_area, $_->work_area, '... two different work_areas');
    isnt($milton->work_area->chair, $_->work_area->chair, '... two different work_area chairs');
    isnt($milton->work_area->desk, $_->work_area->desk, '... two different work_area desks');
    isnt($milton->keycard, $_->keycard, '... two different keycards');
    isnt($milton->keycard->uuid, $_->keycard->uuid, '... two different keycard uuids');
}

done_testing;