[gitmo/Mouse.git] / t / 000-recipes / moose_cookbook_basics_recipe4.t

#!/usr/bin/perl -w

use strict;
use Test::More;
BEGIN{
    if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
        eval 'use Regexp::Common; use Locale::US;';
        if ($@) {
            plan skip_all => 'Regexp::Common & Locale::US required for this test';
        }
        else{
            plan 'no_plan';
        }
    }
    else{
        plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
    }
}

use Test::Exception;
$| = 1;


# =begin testing SETUP
BEGIN {
    eval 'use Regexp::Common; use Locale::US;';
    if ($@) {
        plan skip_all => 'Regexp::Common & Locale::US required for this test';
    }
}


# =begin testing SETUP
{

  package Address;
  use Mouse;
  use Mouse::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 Company;
  use Mouse;
  use Mouse::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 ( @{ $self->employees || [] } ) {
          foreach my $employee ( @{ $self->employees } ) {
              $employee->employer($self);
          }
      }
  }

  after 'employees' => sub {
      my ( $self, $employees ) = @_;
      if ($employees) {
          foreach my $employee ( @{$employees} ) {
              $employee->employer($self);
          }
      }
  };

  package Person;
  use Mouse;

  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 Employee;
  use Mouse;

  extends 'Person';

  has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
  has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );

  override 'full_name' => sub {
      my $self = shift;
      super() . ', ' . $self->title;
  };
}


# =begin testing
{
{
    package Company;

    sub get_employee_count { scalar @{(shift)->employees} }
}

use Scalar::Util 'isweak';

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]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[0]->{employer} ),
    '... 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]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[1]->{employer} ),
    '... 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]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[2]->{employer} ),
    '... 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->employer, $ii, '... has the ii company' );
}

$new_company->employees($ii_employees);

foreach my $employee ( @{ $new_company->employees } ) {
    is( $employee->employer, $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';
}


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