+package Moose::Cookbook::Basics::Recipe4;
+
+# ABSTRACT: Subtypes, and modeling a simple B<Company> class hierarchy
+
+__END__
+
=pod
=begin testing-SETUP
-BEGIN {
- eval 'use Regexp::Common; use Locale::US;';
- if ($@) {
- diag 'Regexp::Common & Locale::US required for this test';
- ok(1);
- exit 0;
- }
-}
+use Test::Requires {
+ 'Locale::US' => '0',
+ 'Regexp::Common' => '0',
+};
=end testing-SETUP
-=head1 NAME
-
-Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
-
=head1 SYNOPSIS
package Address;
has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
has 'address' => ( is => 'rw', isa => 'Address' );
- has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
+ has 'employees' => (
+ is => 'rw',
+ isa => 'ArrayRef[Employee]',
+ default => sub { [] },
+ );
sub BUILD {
my ( $self, $params ) = @_;
- if ( @{ $self->employees || [] } ) {
- foreach my $employee ( @{ $self->employees } ) {
- $employee->employer($self);
- }
+ foreach my $employee ( @{ $self->employees } ) {
+ $employee->employer($self);
}
}
after 'employees' => sub {
my ( $self, $employees ) = @_;
- if ($employees) {
- foreach my $employee ( @{$employees} ) {
- $employee->employer($self);
- }
+ return unless $employees;
+ foreach my $employee ( @$employees ) {
+ $employee->employer($self);
}
};
they're just strings, but we do want to ensure that they're valid.
The type constraints we created are reusable. Type constraints are
-stored by name in a global registry. This means that we can refer to
+stored by name in a global registry, which means that we can refer to
them in other classes. Because the registry is global, we do recommend
-that you use some sort of pseudo-namespacing in real applications,
-like C<MyApp.Type.USState>.
+that you use some sort of namespacing in real applications,
+like C<MyApp::Type::USState> (just as you would do with class names).
These two subtypes allow us to define a simple C<Address> class.
The next attribute, C<employees>, uses a I<parameterized> type
constraint:
- has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
+ has 'employees' => (
+ is => 'rw',
+ isa => 'ArrayRef[Employee]'
+ default => sub { [] },
+ );
This constraint says that C<employees> must be an array reference
where each element of the array is an C<Employee> object. It's worth
noting that an I<empty> array reference also satisfies this
-constraint.
+constraint, such as the value given as the default here.
Parameterizable type constraints (or "container types"), such as
C<ArrayRef[`a]>, can be made more specific with a type parameter. In
To do that, we need to hook into object construction. Moose lets us do
this by writing a C<BUILD> method in our class. When your class
-defined a C<BUILD> method, it will be called immediately after an
-object construction, but before the object is returned to the caller
-(3).
+defines a C<BUILD> method, it will be called by the constructor
+immediately after object construction, but before the object is returned
+to the caller. Note that all C<BUILD> methods in your class hierarchy
+will be called automatically; there is no need to (and you should not)
+call the superclass C<BUILD> method.
The C<Company> class uses the C<BUILD> method to ensure that each
employee of a company has the proper C<Company> object in its
sub BUILD {
my ( $self, $params ) = @_;
- if ( $self->employees ) {
- foreach my $employee ( @{ $self->employees } ) {
- $employee->employer($self);
- }
+ foreach my $employee ( @{ $self->employees } ) {
+ $employee->employer($self);
}
}
-The C<BUILD> method is executed after type constraints are checked, so
-it is safe to assume that C<< $self->employees >> will return an array
-reference, and that the elements of that array will be C<Employee>
-objects.
+The C<BUILD> method is executed after type constraints are checked, so it is
+safe to assume that if C<< $self->employees >> has a value, it will be an
+array reference, and that the elements of that array reference will be
+C<Employee> objects.
We also want to make sure that whenever the C<employees> attribute for
a C<Company> is changed, we also update the C<employer> for each
after 'employees' => sub {
my ( $self, $employees ) = @_;
- if ($employees) {
- foreach my $employee ( @{$employees} ) {
- $employee->employer($self);
- }
+ return unless $employees;
+ foreach my $employee ( @$employees ) {
+ $employee->employer($self);
}
};
-Again, as with the C<BUILD> method, we know that the type constraint
-check has already happened, so we can just check for definedness on the
-C<$employees> argument.
+Again, as with the C<BUILD> method, we know that the type constraint check has
+already happened, so we know that if C<$employees> is defined it will contain
+an array reference of C<Employee> objects.
+
+Note that C<employees> is a read/write accessor, so we must return early if
+it's called as a reader.
The B<Person> class does not really demonstrate anything new. It has several
C<required> attributes. It also has a C<predicate> method, which we
-first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
+first used in L<Moose::Cookbook::Basics::BinaryTree_AttributeFeatures>.
The only new feature in the C<Employee> class is the C<override>
method modifier:
parameters that were passed to the method.
A more detailed example of usage can be found in
-F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
+F<t/recipes/moose_cookbook_basics_recipe4.t>.
=head1 CONCLUSION
container type, and instead you will have a new type named
"ArrayRef[]", which doesn't make any sense.
-=item (3)
-
-The C<BUILD> method is actually called by C<< Moose::Object->BUILDALL
->>, which is called by C<< Moose::Object->new >>. The C<BUILDALL>
-method climbs the object inheritance graph and calls any C<BUILD>
-methods it finds in the correct order.
-
=back
-=head1 AUTHORS
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=begin testing
{
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' )
+is(
+ exception {
+ $ii = Company->new(
+ {
+ name => 'Infinity Interactive',
+ address => Address->new(
+ street => '565 Plandome Rd., Suite 307',
+ city => 'Manhasset',
+ state => 'NY',
+ zip_code => '11030'
),
- 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';
+ 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' )
+ ),
+ ]
+ }
+ );
+ },
+ undef,
+ '... created the entire company successfully'
+);
+
isa_ok( $ii, 'Company' );
is( $ii->name, 'Infinity Interactive',
## 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';
+isnt(
+ exception {
+ Address->new( street => {} ),;
+ },
+ undef,
+ '... we die correctly with bad args'
+);
+
+isnt(
+ exception {
+ Address->new( city => {} ),;
+ },
+ undef,
+ '... we die correctly with bad args'
+);
+
+isnt(
+ exception {
+ Address->new( state => 'British Columbia' ),;
+ },
+ undef,
+ '... we die correctly with bad args'
+);
+
+is(
+ exception {
+ Address->new( state => 'Connecticut' ),;
+ },
+ undef,
+ '... we live correctly with good args'
+);
+
+isnt(
+ exception {
+ Address->new( zip_code => 'AF5J6$' ),;
+ },
+ undef,
+ '... we die correctly with bad args'
+);
+
+is(
+ exception {
+ Address->new( zip_code => '06443' ),;
+ },
+ undef,
+ '... we live correctly with good args'
+);
+
+isnt(
+ exception {
+ Company->new(),;
+ },
+ undef,
+ '... we die correctly without good args'
+);
+
+is(
+ exception {
+ Company->new( name => 'Foo' ),;
+ },
+ undef,
+ '... we live correctly without good args'
+);
+
+isnt(
+ exception {
+ Company->new( name => 'Foo', employees => [ Person->new ] ),;
+ },
+ undef,
+ '... we die correctly with good args'
+);
+
+is(
+ exception {
+ Company->new( name => 'Foo', employees => [] ),;
+ },
+ undef,
+ '... we live correctly with good args'
+);
=end testing
projects / gitmo/Moose.git / blobdiff