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