lib/Moose/Cookbook/Recipe4.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Recipe4
   7
   8 =head1 SYNOPSIS
   9
  10   package Address;
  11   use strict;
  12   use warnings;
  13   use Moose;
  14
  15   use Locale::US;
  16   use Regexp::Common 'zip';
  17
  18   my $STATES = Locale::US->new;
  19
  20   subtype USState
  21       => as Str
  22       => where {
  23           (exists $STATES->{code2state}{uc($_)} || exists $STATES->{state2code}{uc($_)})
  24       };
  25
  26   subtype USZipCode
  27       => as Value
  28       => where {
  29           /^$RE{zip}{US}{-extended => 'allow'}$/
  30       };
  31
  32   has 'street'   => (is => 'rw', isa => 'Str');
  33   has 'city'     => (is => 'rw', isa => 'Str');
  34   has 'state'    => (is => 'rw', isa => 'USState');
  35   has 'zip_code' => (is => 'rw', isa => 'USZipCode');
  36
  37   package Company;
  38   use strict;
  39   use warnings;
  40   use Moose;
  41
  42   has 'name'      => (is => 'rw', isa => 'Str', required => 1);
  43   has 'address'   => (is => 'rw', isa => 'Address');
  44   has 'employees' => (is => 'rw', isa => subtype ArrayRef => where {
  45       ($_->isa('Employee') || return) for @$_; 1
  46   });
  47
  48   sub BUILD {
  49       my ($self, $params) = @_;
  50       if ($params->{employees}) {
  51           foreach my $employee (@{$params->{employees}}) {
  52               $employee->company($self);
  53           }
  54       }
  55   }
  56
  57   sub get_employee_count { scalar @{(shift)->employees} }
  58
  59   package Person;
  60   use strict;
  61   use warnings;
  62   use Moose;
  63
  64   has 'first_name'     => (is => 'rw', isa => 'Str', required => 1);
  65   has 'last_name'      => (is => 'rw', isa => 'Str', required => 1);
  66   has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');
  67   has 'address'        => (is => 'rw', isa => 'Address');
  68
  69   sub full_name {
  70       my $self = shift;
  71       return $self->first_name .
  72             ($self->has_middle_initial ? ' ' . $self->middle_initial . '. ' : ' ') .
  73              $self->last_name;
  74   }
  75
  76   package Employee;
  77   use strict;
  78   use warnings;
  79   use Moose;
  80
  81   extends 'Person';
  82
  83   has 'title'   => (is => 'rw', isa => 'Str', required => 1);
  84   has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
  85
  86   override 'full_name' => sub {
  87       my $self = shift;
  88       super() . ', ' . $self->title
  89   };
  90
  91 =head1 DESCRIPTION
  92
  93 =head1 AUTHOR
  94
  95 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  96
  97 =head1 COPYRIGHT AND LICENSE
  98
  99 Copyright 2006 by Infinity Interactive, Inc.
 100
 101 L<http://www.iinteractive.com>
 102
 103 This library is free software; you can redistribute it and/or modify
 104 it under the same terms as Perl itself.
 105
 106 =cut