NAME
Moose::Cookbook::Recipe4 - Subtypes, and modeling a simple Company class hierarchy
SYNOPSIS
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 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 => subtype ArrayRef => where {
(blessed($_) && $_->isa('Employee') || return) for @$_; 1
});
sub BUILD {
my ($self, $params) = @_;
if ($params->{employees}) {
foreach my $employee (@{$params->{employees}}) {
$employee->company($self);
}
}
}
after 'employees' => sub {
my ($self, $employees) = @_;
if (defined $employees) {
foreach my $employee (@{$employees}) {
$employee->company($self);
}
}
};
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 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
};
DESCRIPTION
In this recipe we introduce the subtype
keyword, and show how it can be useful for specifying type constraints without building an entire class to represent them. We will also show how this feature can be used to leverage the usefulness of CPAN modules. In addition to this, we will introduce another attribute option.
Let's first look at the subtype
feature. In the Address class we have defined two subtypes. The first subtype
uses the Locale::US module, which provides two hashes which can be used to perform existential checks for state names and their two letter state codes. It is a very simple and very useful module, and perfect for use in a subtype
constraint.
my $STATES = Locale::US->new;
subtype USState
=> as Str
=> where {
(exists $STATES->{code2state}{uc($_)} ||
exists $STATES->{state2code}{uc($_)})
};
Because we know that states will be passed to us as strings, we can make USState
a subtype of the built-in type constraint Str
. This will ensure that anything which is a USState
will also pass as a Str
. Next, we create a constraint specializer using the where
keyword. The value being checked against in the where
clause can be found in the $_
variable (1). Our constraint specializer will then check whether the given string is either a state name or a state code. If the string meets this criteria, then the constraint will pass, otherwise it will fail. We can now use this as we would any built-in constraint, like so:
has 'state' => (is => 'rw', isa => 'USState');
The state
accessor will now check all values against the USState
constraint, thereby only allowing valid state names or state codes to be stored in the state
slot.
The next subtype
does pretty much the same thing using the Regexp::Common module, and is used as the constraint for the zip_code
slot.
subtype USZipCode
=> as Value
=> where {
/^$RE{zip}{US}{-extended => 'allow'}$/
};
Using subtypes can save a lot of unnecessary abstraction by not requiring you to create many small classes for these relatively simple values. They also allow you to reuse the same constraints in a number of classes (thereby avoiding duplication), since all type constraints are stored in a global registry and always accessible to has
.
With these two subtypes and some attributes, we have defined as much as we need for a basic Address class. Next, we define a basic Company class, which itself has an address. As we saw in earlier recipes, we can use the Address
type constraint that Moose automatically created for us:
has 'address' => (is => 'rw', isa => 'Address');
A company also needs a name, so we define that as well:
has 'name' => (is => 'rw', isa => 'Str', required => 1);
Here we introduce another attribute option, the required
option. This option tells Moose that name
is a required parameter in the Company constructor, and that the name
accessor cannot accept an undefined value for the slot. The result is that name
will always have a value.
The next attribute option is not actually new, but a new variant of options we have already introduced:
has 'employees' => (is => 'rw', isa => subtype ArrayRef => where {
(blessed($_) && $_->isa('Employee') || return) for @$_; 1
});
Here, instead of passing a string to the isa
option, we are passing an anonymous subtype of the ArrayRef
type constraint. This subtype basically checks that all the values in the ARRAY ref are instances of the Employee class.
This will ensure that our employees will all be of the correct type. However, the Employee object (which we will see in a moment) also maintains a reference to its associated Company. In order to maintain this relationship (and preserve the referential integrity of our objects), we need to perform some processing of the employees over and above that of the type constraint check. This is accomplished in two places. First we need to be sure that any employees array passed to the constructor is properly initialized. For this we can use the BUILD
method (2):
sub BUILD {
my ($self, $params) = @_;
if ($params->{employees}) {
foreach my $employee (@{$params->{employees}}) {
$employee->company($self);
}
}
}
The BUILD
method will be executed after the initial type constraint check, so we can simply perform a basic existential check on the employees
param here, and assume that if it does exist, it is both an ARRAY ref and contains only instances of Employee.
The next aspect we need to address is the employees
read/write accessor (see the employees
attribute declaration above). This accessor will correctly check the type constraint, but we need to extend it with some additional processing. For this we use an after
method modifier, like so:
after 'employees' => sub {
my ($self, $employees) = @_;
if (defined $employees) {
foreach my $employee (@{$employees}) {
$employee->company($self);
}
}
};
Again, as with the BUILD
method, we know that the type constraint check has already happened, so we can just check for defined-ness on the $employees
argument.
At this point, our Company class is complete. Next comes our Person class and its subclass, the previously mentioned Employee class.
The Person class should be obvious to you at this point. It has a few required
attributes, and the middle_initial
slot has an additional predicate
method (which we saw in the previous recipe with the BinaryTree class).
Next, the Employee class, which should also be pretty obvious at this point. It requires a title
, and maintains a weakened reference to a Company instance. The only new item, which we have seen before in examples, but never in the recipe itself, is the override
method modifier:
override 'full_name' => sub {
my $self = shift;
super() . ', ' . $self->title
};
This just tells Moose that I am intentionally overriding the superclass full_name
method here, and adding the value of the title
slot at the end of the employee's full name.
And that's about it.
Once again, as with all the other recipes, you can go about using these classes like any other Perl 5 class. A more detailed example of usage can be found in t/004_recipe.t.
CONCLUSION
This recipe was intentionally longer and more complex to illustrate both how easily Moose classes can interact (using class type constraints, etc.) and the sheer density of information and behaviors which Moose can pack into a relatively small amount of typing. Ponder for a moment how much more code a non-Moose plain old Perl 5 version of this recipe would have been (including all the type constraint checks, weak references, and so on).
And of course, this recipe also introduced the subtype
keyword, and its usefulness within the Moose toolkit. In the next recipe we will focus more on subtypes, and introduce the idea of type coercion as well.
FOOTNOTES
- (1)
-
The value being checked is also passed as the first argument to the
where
block as well, so it can also be accessed as$_[0]
as well. - (2)
-
The
BUILD
method is called byMoose::Object::BUILDALL
, which is called byMoose::Object::new
.BUILDALL
will climb the object inheritance graph and call the appropriateBUILD
methods in the correct order.
AUTHOR
Stevan Little <stevan@iinteractive.com>
COPYRIGHT AND LICENSE
Copyright 2006, 2007 by Infinity Interactive, Inc.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.