[gitmo/Moose.git] / t / 000_recipes / basics / 004_company.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More; 

BEGIN {
    eval "use Regexp::Common; use Locale::US;";
    plan skip_all => "Regexp::Common & Locale::US required for this test" if $@;        
    plan tests => 65;    
}

use Test::Exception;
use Scalar::Util 'isweak';


{
    package Address;
    use Moose;
    use Moose::Util::TypeConstraints;
    
    use Locale::US;
    use Regexp::Common 'zip';
    
    my $STATES = Locale::US->new;
    
    subtype USState 
        => as Str
        => where {
            (exists $STATES->{code2state}{uc($_)} || exists $STATES->{state2code}{uc($_)})
        };
        
    subtype USZipCode 
        => as Value
        => where {
            /^$RE{zip}{US}{-extended => 'allow'}$/            
        };
    
    has 'street'   => (is => 'rw', isa => 'Str');
    has 'city'     => (is => 'rw', isa => 'Str');
    has 'state'    => (is => 'rw', isa => 'USState');
    has 'zip_code' => (is => 'rw', isa => 'USZipCode');   
    
    __PACKAGE__->meta->make_immutable(debug => 0);
}{
    
    package Company;
    use Moose;
    use Moose::Util::TypeConstraints;    
    
    has 'name'      => (is => 'rw', isa => 'Str', required => 1);
    has 'address'   => (is => 'rw', isa => 'Address'); 
    has 'employees' => (is => 'rw', isa => 'ArrayRef[Employee]');    
    
    sub BUILD {
        my ($self, $params) = @_;
        if ($params->{employees}) {
            foreach my $employee (@{$params->{employees}}) {
                $employee->company($self);
            }
        }
    }
    
    sub get_employee_count { scalar @{(shift)->employees} }
    
    after 'employees' => sub {
        my ($self, $employees) = @_;
        # if employees is defined, it 
        # has already been type checked
        if (defined $employees) {
            # make sure each gets the 
            # weak ref to the company
            foreach my $employee (@{$employees}) {
                $employee->company($self);
            }            
        }
    };
    
    __PACKAGE__->meta->make_immutable(debug => 0);
}{    
    
    package Person;
    use Moose;
    
    has 'first_name'     => (is => 'rw', isa => 'Str', required => 1);
    has 'last_name'      => (is => 'rw', isa => 'Str', required => 1);       
    has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');  
    has 'address'        => (is => 'rw', isa => 'Address');
    
    sub full_name {
        my $self = shift;
        return $self->first_name . 
              ($self->has_middle_initial ? ' ' . $self->middle_initial . '. ' : ' ') .
               $self->last_name;
    }

    __PACKAGE__->meta->make_immutable(debug => 0);
}{
      
    package Employee;
    use Moose;  
    
    extends 'Person';
    
    has 'title'   => (is => 'rw', isa => 'Str', required => 1);
    has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);  
    
    override 'full_name' => sub {
        my $self = shift;
        super() . ', ' . $self->title
    };
    
    __PACKAGE__->meta->make_immutable(debug => 0);
}

my $ii;
lives_ok {
    $ii = Company->new({
        name    => 'Infinity Interactive',
        address => Address->new(
            street   => '565 Plandome Rd., Suite 307',
            city     => 'Manhasset',
            state    => 'NY',
            zip_code => '11030'
        ),
        employees => [
            Employee->new(
                first_name     => 'Jeremy',
                last_name      => 'Shao',
                title          => 'President / Senior Consultant',
                address        => Address->new(city => 'Manhasset', state => 'NY')
            ),
            Employee->new(
                first_name     => 'Tommy',
                last_name      => 'Lee',
                title          => 'Vice President / Senior Developer',
                address        => Address->new(city => 'New York', state => 'NY')
            ),        
            Employee->new(
                first_name     => 'Stevan',
                middle_initial => 'C',
                last_name      => 'Little',
                title          => 'Senior Developer',            
                address        => Address->new(city => 'Madison', state => 'CT')
            ),          
        ]
    });
} '... created the entire company successfully';
isa_ok($ii, 'Company');

is($ii->name, 'Infinity Interactive', '... got the right name for the company');

isa_ok($ii->address, 'Address');
is($ii->address->street, '565 Plandome Rd., Suite 307', '... got the right street address');
is($ii->address->city, 'Manhasset', '... got the right city');
is($ii->address->state, 'NY', '... got the right state');
is($ii->address->zip_code, 11030, '... got the zip code');

is($ii->get_employee_count, 3, '... got the right employee count');

# employee #1

isa_ok($ii->employees->[0], 'Employee');
isa_ok($ii->employees->[0], 'Person');

is($ii->employees->[0]->first_name, 'Jeremy', '... got the right first name');
is($ii->employees->[0]->last_name, 'Shao', '... got the right last name');
ok(!$ii->employees->[0]->has_middle_initial, '... no middle initial');
is($ii->employees->[0]->middle_initial, undef, '... got the right middle initial value');
is($ii->employees->[0]->full_name, 'Jeremy Shao, President / Senior Consultant', '... got the right full name');
is($ii->employees->[0]->title, 'President / Senior Consultant', '... got the right title');
is($ii->employees->[0]->company, $ii, '... got the right company');
ok(isweak($ii->employees->[0]->{company}), '... the company is a weak-ref');

isa_ok($ii->employees->[0]->address, 'Address');
is($ii->employees->[0]->address->city, 'Manhasset', '... got the right city');
is($ii->employees->[0]->address->state, 'NY', '... got the right state');

# employee #2

isa_ok($ii->employees->[1], 'Employee');
isa_ok($ii->employees->[1], 'Person');

is($ii->employees->[1]->first_name, 'Tommy', '... got the right first name');
is($ii->employees->[1]->last_name, 'Lee', '... got the right last name');
ok(!$ii->employees->[1]->has_middle_initial, '... no middle initial');
is($ii->employees->[1]->middle_initial, undef, '... got the right middle initial value');
is($ii->employees->[1]->full_name, 'Tommy Lee, Vice President / Senior Developer', '... got the right full name');
is($ii->employees->[1]->title, 'Vice President / Senior Developer', '... got the right title');
is($ii->employees->[1]->company, $ii, '... got the right company');
ok(isweak($ii->employees->[1]->{company}), '... the company is a weak-ref');

isa_ok($ii->employees->[1]->address, 'Address');
is($ii->employees->[1]->address->city, 'New York', '... got the right city');
is($ii->employees->[1]->address->state, 'NY', '... got the right state');

# employee #3

isa_ok($ii->employees->[2], 'Employee');
isa_ok($ii->employees->[2], 'Person');

is($ii->employees->[2]->first_name, 'Stevan', '... got the right first name');
is($ii->employees->[2]->last_name, 'Little', '... got the right last name');
ok($ii->employees->[2]->has_middle_initial, '... got middle initial');
is($ii->employees->[2]->middle_initial, 'C', '... got the right middle initial value');
is($ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer', '... got the right full name');
is($ii->employees->[2]->title, 'Senior Developer', '... got the right title');
is($ii->employees->[2]->company, $ii, '... got the right company');
ok(isweak($ii->employees->[2]->{company}), '... the company is a weak-ref');

isa_ok($ii->employees->[2]->address, 'Address');
is($ii->employees->[2]->address->city, 'Madison', '... got the right city');
is($ii->employees->[2]->address->state, 'CT', '... got the right state');

# create new company

my $new_company = Company->new(name => 'Infinity Interactive International');
isa_ok($new_company, 'Company');

my $ii_employees = $ii->employees;
foreach my $employee (@$ii_employees) {
    is($employee->company, $ii, '... has the ii company');
}

$new_company->employees($ii_employees);

foreach my $employee (@{$new_company->employees}) {
    is($employee->company, $new_company, '... has the different company now');
}

## check some error conditions for the subtypes

dies_ok {
    Address->new(street => {}),    
} '... we die correctly with bad args';

dies_ok {
    Address->new(city => {}),    
} '... we die correctly with bad args';

dies_ok {
    Address->new(state => 'British Columbia'),    
} '... we die correctly with bad args';

lives_ok {
    Address->new(state => 'Connecticut'),    
} '... we live correctly with good args';

dies_ok {
    Address->new(zip_code => 'AF5J6$'),    
} '... we die correctly with bad args';

lives_ok {
    Address->new(zip_code => '06443'),    
} '... we live correctly with good args';

dies_ok {
    Company->new(),    
} '... we die correctly without good args';

lives_ok {
    Company->new(name => 'Foo'),    
} '... we live correctly without good args';

dies_ok {
    Company->new(name => 'Foo', employees => [ Person->new ]),    
} '... we die correctly with good args';

lives_ok {
    Company->new(name => 'Foo', employees => []),    
} '... we live correctly with good args';
Commit	Line	Data
5569c072	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
51c5e0fb	6	use Test::More;
	7
	8	BEGIN {
	9	eval "use Regexp::Common; use Locale::US;";
	10	plan skip_all => "Regexp::Common & Locale::US required for this test" if $@;
e606ae5f	11	plan tests => 65;
51c5e0fb	12	}
51c5e0fb	13
5569c072	14	use Test::Exception;
51c5e0fb	15	use Scalar::Util 'isweak';
51c5e0fb	16
e606ae5f	17
5569c072	18
	19	{
	20	package Address;
5569c072	21	use Moose;
05d9eaf6	22	use Moose::Util::TypeConstraints;
5569c072	23
	24	use Locale::US;
	25	use Regexp::Common 'zip';
	26
	27	my $STATES = Locale::US->new;
	28
	29	subtype USState
	30	=> as Str
	31	=> where {
	32	(exists $STATES->{code2state}{uc($_)} \|\| exists $STATES->{state2code}{uc($_)})
	33	};
	34
	35	subtype USZipCode
	36	=> as Value
	37	=> where {
	38	/^$RE{zip}{US}{-extended => 'allow'}$/
	39	};
	40
182134e8	41	has 'street' => (is => 'rw', isa => 'Str');
	42	has 'city' => (is => 'rw', isa => 'Str');
	43	has 'state' => (is => 'rw', isa => 'USState');
	44	has 'zip_code' => (is => 'rw', isa => 'USZipCode');
5569c072	45
5a3217de	46	__PACKAGE__->meta->make_immutable(debug => 0);
f1917f58	47	}{
	48
	49	package Company;
	50	use Moose;
	51	use Moose::Util::TypeConstraints;
	52
	53	has 'name' => (is => 'rw', isa => 'Str', required => 1);
	54	has 'address' => (is => 'rw', isa => 'Address');
	55	has 'employees' => (is => 'rw', isa => 'ArrayRef[Employee]');
	56
	57	sub BUILD {
	58	my ($self, $params) = @_;
	59	if ($params->{employees}) {
	60	foreach my $employee (@{$params->{employees}}) {
	61	$employee->company($self);
	62	}
	63	}
	64	}
	65
	66	sub get_employee_count { scalar @{(shift)->employees} }
	67
	68	after 'employees' => sub {
	69	my ($self, $employees) = @_;
	70	# if employees is defined, it
	71	# has already been type checked
	72	if (defined $employees) {
	73	# make sure each gets the
	74	# weak ref to the company
	75	foreach my $employee (@{$employees}) {
	76	$employee->company($self);
	77	}
	78	}
	79	};
	80
5a3217de	81	__PACKAGE__->meta->make_immutable(debug => 0);
5cf3dbcf	82	}{
5cf3dbcf	83
5569c072	84	package Person;
5569c072	85	use Moose;
5569c072	86
7c6cacb4	87	has 'first_name' => (is => 'rw', isa => 'Str', required => 1);
7c6cacb4	88	has 'last_name' => (is => 'rw', isa => 'Str', required => 1);
182134e8	89	has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');
5569c072	90	has 'address' => (is => 'rw', isa => 'Address');
	91
	92	sub full_name {
	93	my $self = shift;
	94	return $self->first_name .
	95	($self->has_middle_initial ? ' ' . $self->middle_initial . '. ' : ' ') .
	96	$self->last_name;
	97	}
5cf3dbcf	98
5a3217de	99	__PACKAGE__->meta->make_immutable(debug => 0);
5cf3dbcf	100	}{
5569c072	101
5569c072	102	package Employee;
5569c072	103	use Moose;
	104
	105	extends 'Person';
	106
7c6cacb4	107	has 'title' => (is => 'rw', isa => 'Str', required => 1);
5569c072	108	has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
b6fe348f	109
	110	override 'full_name' => sub {
	111	my $self = shift;
	112	super() . ', ' . $self->title
	113	};
5cf3dbcf	114
5a3217de	115	__PACKAGE__->meta->make_immutable(debug => 0);
5569c072	116	}
	117
	118	my $ii;
	119	lives_ok {
05d9eaf6	120	$ii = Company->new({
5569c072	121	name => 'Infinity Interactive',
	122	address => Address->new(
	123	street => '565 Plandome Rd., Suite 307',
	124	city => 'Manhasset',
	125	state => 'NY',
	126	zip_code => '11030'
	127	),
	128	employees => [
	129	Employee->new(
	130	first_name => 'Jeremy',
	131	last_name => 'Shao',
	132	title => 'President / Senior Consultant',
	133	address => Address->new(city => 'Manhasset', state => 'NY')
	134	),
	135	Employee->new(
	136	first_name => 'Tommy',
	137	last_name => 'Lee',
	138	title => 'Vice President / Senior Developer',
	139	address => Address->new(city => 'New York', state => 'NY')
	140	),
	141	Employee->new(
	142	first_name => 'Stevan',
	143	middle_initial => 'C',
	144	last_name => 'Little',
	145	title => 'Senior Developer',
	146	address => Address->new(city => 'Madison', state => 'CT')
638585e1	147	),
5569c072	148	]
05d9eaf6	149	});
5569c072	150	} '... created the entire company successfully';
	151	isa_ok($ii, 'Company');
	152
	153	is($ii->name, 'Infinity Interactive', '... got the right name for the company');
	154
	155	isa_ok($ii->address, 'Address');
	156	is($ii->address->street, '565 Plandome Rd., Suite 307', '... got the right street address');
	157	is($ii->address->city, 'Manhasset', '... got the right city');
	158	is($ii->address->state, 'NY', '... got the right state');
	159	is($ii->address->zip_code, 11030, '... got the zip code');
	160
638585e1	161	is($ii->get_employee_count, 3, '... got the right employee count');
5569c072	162
	163	# employee #1
	164
	165	isa_ok($ii->employees->[0], 'Employee');
	166	isa_ok($ii->employees->[0], 'Person');
	167
	168	is($ii->employees->[0]->first_name, 'Jeremy', '... got the right first name');
	169	is($ii->employees->[0]->last_name, 'Shao', '... got the right last name');
	170	ok(!$ii->employees->[0]->has_middle_initial, '... no middle initial');
	171	is($ii->employees->[0]->middle_initial, undef, '... got the right middle initial value');
b6fe348f	172	is($ii->employees->[0]->full_name, 'Jeremy Shao, President / Senior Consultant', '... got the right full name');
5569c072	173	is($ii->employees->[0]->title, 'President / Senior Consultant', '... got the right title');
5569c072	174	is($ii->employees->[0]->company, $ii, '... got the right company');
51c5e0fb	175	ok(isweak($ii->employees->[0]->{company}), '... the company is a weak-ref');
5569c072	176
	177	isa_ok($ii->employees->[0]->address, 'Address');
	178	is($ii->employees->[0]->address->city, 'Manhasset', '... got the right city');
	179	is($ii->employees->[0]->address->state, 'NY', '... got the right state');
	180
	181	# employee #2
	182
	183	isa_ok($ii->employees->[1], 'Employee');
	184	isa_ok($ii->employees->[1], 'Person');
	185
	186	is($ii->employees->[1]->first_name, 'Tommy', '... got the right first name');
	187	is($ii->employees->[1]->last_name, 'Lee', '... got the right last name');
	188	ok(!$ii->employees->[1]->has_middle_initial, '... no middle initial');
	189	is($ii->employees->[1]->middle_initial, undef, '... got the right middle initial value');
b6fe348f	190	is($ii->employees->[1]->full_name, 'Tommy Lee, Vice President / Senior Developer', '... got the right full name');
5569c072	191	is($ii->employees->[1]->title, 'Vice President / Senior Developer', '... got the right title');
5569c072	192	is($ii->employees->[1]->company, $ii, '... got the right company');
51c5e0fb	193	ok(isweak($ii->employees->[1]->{company}), '... the company is a weak-ref');
5569c072	194
	195	isa_ok($ii->employees->[1]->address, 'Address');
	196	is($ii->employees->[1]->address->city, 'New York', '... got the right city');
	197	is($ii->employees->[1]->address->state, 'NY', '... got the right state');
	198
	199	# employee #3
	200
	201	isa_ok($ii->employees->[2], 'Employee');
	202	isa_ok($ii->employees->[2], 'Person');
	203
	204	is($ii->employees->[2]->first_name, 'Stevan', '... got the right first name');
	205	is($ii->employees->[2]->last_name, 'Little', '... got the right last name');
	206	ok($ii->employees->[2]->has_middle_initial, '... got middle initial');
	207	is($ii->employees->[2]->middle_initial, 'C', '... got the right middle initial value');
b6fe348f	208	is($ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer', '... got the right full name');
5569c072	209	is($ii->employees->[2]->title, 'Senior Developer', '... got the right title');
5569c072	210	is($ii->employees->[2]->company, $ii, '... got the right company');
51c5e0fb	211	ok(isweak($ii->employees->[2]->{company}), '... the company is a weak-ref');
5569c072	212
	213	isa_ok($ii->employees->[2]->address, 'Address');
	214	is($ii->employees->[2]->address->city, 'Madison', '... got the right city');
	215	is($ii->employees->[2]->address->state, 'CT', '... got the right state');
	216
ad5ed80c	217	# create new company
	218
	219	my $new_company = Company->new(name => 'Infinity Interactive International');
	220	isa_ok($new_company, 'Company');
	221
	222	my $ii_employees = $ii->employees;
	223	foreach my $employee (@$ii_employees) {
	224	is($employee->company, $ii, '... has the ii company');
	225	}
	226
	227	$new_company->employees($ii_employees);
	228
	229	foreach my $employee (@{$new_company->employees}) {
	230	is($employee->company, $new_company, '... has the different company now');
	231	}
	232
5569c072	233	## check some error conditions for the subtypes
	234
	235	dies_ok {
51c5e0fb	236	Address->new(street => {}),
	237	} '... we die correctly with bad args';
	238
	239	dies_ok {
	240	Address->new(city => {}),
	241	} '... we die correctly with bad args';
	242
	243	dies_ok {
5569c072	244	Address->new(state => 'British Columbia'),
	245	} '... we die correctly with bad args';
	246
	247	lives_ok {
	248	Address->new(state => 'Connecticut'),
	249	} '... we live correctly with good args';
	250
	251	dies_ok {
	252	Address->new(zip_code => 'AF5J6$'),
	253	} '... we die correctly with bad args';
	254
	255	lives_ok {
	256	Address->new(zip_code => '06443'),
	257	} '... we live correctly with good args';
	258
	259	dies_ok {
7c6cacb4	260	Company->new(),
	261	} '... we die correctly without good args';
	262
	263	lives_ok {
	264	Company->new(name => 'Foo'),
	265	} '... we live correctly without good args';
	266
	267	dies_ok {
	268	Company->new(name => 'Foo', employees => [ Person->new ]),
5569c072	269	} '... we die correctly with good args';
	270
	271	lives_ok {
7c6cacb4	272	Company->new(name => 'Foo', employees => []),
5569c072	273	} '... we live correctly with good args';
5569c072	274