---
name: "Moose::Cookbook::Recipe4"
section: "3pm"
platform: "linux"
package: "libmoose-perl"
version: "0.54-1"
release: "Debian 5.0 (Lenny)"
platforms: ["linux"]
url: "https://new.carta.tech/Moose::Cookbook::Recipe4"
---

# Moose::Cookbook::Recipe4(3pm)

Subtypes, and modeling a simple Company class hierarchy

## 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 => 'ArrayRef[Employee]');

  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 => 'ArrayRef[Employee]');
```

Here, we are passing a more complex string to the `"isa"` option, we  are passing a container type constraint. Container type constraints  can either be `"ArrayRef"` or `"HashRef"` with a contained type given  inside the square brackets. This 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/000\_recipes/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 by `"Moose::Object::BUILDALL"`, which is  called by `"Moose::Object::new"`. `"BUILDALL"` will climb the object  inheritance graph and call the appropriate `"BUILD"` methods in the  correct order.

## AUTHOR

Stevan Little \<stevan@iinteractive.com\>

## COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

\<http://www.iinteractive.com\>

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.