t/000_recipes/basics/004_company.t

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