[gitmo/Mouse.git] / t / 000_recipes / moose_cookbook_basics_recipe4.t

#!/usr/bin/perl -w

use strict;
use Test::More;
BEGIN{
    eval 'use Regexp::Common; use Locale::US;';
    if ($@) {
        plan skip_all => 'Regexp::Common & Locale::US required for this test';
    }
    else{
        plan 'no_plan';
    }
}

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