t/004_basic.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 => 70;
  12 }
  13
  14 use Test::Exception;
  15
  16 use Scalar::Util 'isweak';
  17
  18 BEGIN {
  19     use_ok('Moose');
  20 }
  21
  22 {
  23     package Address;
  24     use strict;
  25     use warnings;
  26     use Moose;
  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
  55     has 'name'      => (is => 'rw', isa => 'Str');
  56     has 'address'   => (is => 'rw', isa => 'Address');
  57     has 'employees' => (is => 'rw', isa => subtype ArrayRef => where {
  58         ($_->isa('Employee') || return) for @$_; 1
  59     });
  60
  61     sub BUILD {
  62         my ($self, %params) = @_;
  63         if ($params{employees}) {
  64             foreach my $employee (@{$params{employees}}) {
  65                 $employee->company($self);
  66             }
  67         }
  68     }
  69
  70     sub get_employee_count { scalar @{(shift)->employees} }
  71
  72     package Person;
  73     use strict;
  74     use warnings;
  75     use Moose;
  76
  77     has 'first_name'     => (is => 'rw', isa => 'Str');
  78     has 'last_name'      => (is => 'rw', isa => 'Str');
  79     has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');
  80     has 'address'        => (is => 'rw', isa => 'Address');
  81
  82     sub full_name {
  83         my $self = shift;
  84         return $self->first_name .
  85               ($self->has_middle_initial ? ' ' . $self->middle_initial . '. ' : ' ') .
  86                $self->last_name;
  87     }
  88
  89     package Employee;
  90     use strict;
  91     use warnings;
  92     use Moose;
  93
  94     extends 'Person';
  95
  96     has 'title'   => (is => 'rw', isa => 'Str');
  97     has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
  98 }
  99
 100 my $ii;
 101 lives_ok {
 102     $ii = Company->new(
 103         name    => 'Infinity Interactive',
 104         address => Address->new(
 105             street   => '565 Plandome Rd., Suite 307',
 106             city     => 'Manhasset',
 107             state    => 'NY',
 108             zip_code => '11030'
 109         ),
 110         employees => [
 111             Employee->new(
 112                 first_name     => 'Jeremy',
 113                 last_name      => 'Shao',
 114                 title          => 'President / Senior Consultant',
 115                 address        => Address->new(city => 'Manhasset', state => 'NY')
 116             ),
 117             Employee->new(
 118                 first_name     => 'Tommy',
 119                 last_name      => 'Lee',
 120                 title          => 'Vice President / Senior Developer',
 121                 address        => Address->new(city => 'New York', state => 'NY')
 122             ),
 123             Employee->new(
 124                 first_name     => 'Stevan',
 125                 middle_initial => 'C',
 126                 last_name      => 'Little',
 127                 title          => 'Senior Developer',
 128                 address        => Address->new(city => 'Madison', state => 'CT')
 129             ),
 130             Employee->new(
 131                 first_name     => 'Rob',
 132                 last_name      => 'Kinyon',
 133                 title          => 'Developer',
 134                 address        => Address->new(city => 'Marysville', state => 'OH')
 135             ),
 136         ]
 137     );
 138 } '... created the entire company successfully';
 139 isa_ok($ii, 'Company');
 140
 141 is($ii->name, 'Infinity Interactive', '... got the right name for the company');
 142
 143 isa_ok($ii->address, 'Address');
 144 is($ii->address->street, '565 Plandome Rd., Suite 307', '... got the right street address');
 145 is($ii->address->city, 'Manhasset', '... got the right city');
 146 is($ii->address->state, 'NY', '... got the right state');
 147 is($ii->address->zip_code, 11030, '... got the zip code');
 148
 149 is($ii->get_employee_count, 4, '... got the right employee count');
 150
 151 # employee #1
 152
 153 isa_ok($ii->employees->[0], 'Employee');
 154 isa_ok($ii->employees->[0], 'Person');
 155
 156 is($ii->employees->[0]->first_name, 'Jeremy', '... got the right first name');
 157 is($ii->employees->[0]->last_name, 'Shao', '... got the right last name');
 158 ok(!$ii->employees->[0]->has_middle_initial, '... no middle initial');
 159 is($ii->employees->[0]->middle_initial, undef, '... got the right middle initial value');
 160 is($ii->employees->[0]->full_name, 'Jeremy Shao', '... got the right full name');
 161 is($ii->employees->[0]->title, 'President / Senior Consultant', '... got the right title');
 162 is($ii->employees->[0]->company, $ii, '... got the right company');
 163 ok(isweak($ii->employees->[0]->{company}), '... the company is a weak-ref');
 164
 165 isa_ok($ii->employees->[0]->address, 'Address');
 166 is($ii->employees->[0]->address->city, 'Manhasset', '... got the right city');
 167 is($ii->employees->[0]->address->state, 'NY', '... got the right state');
 168
 169 # employee #2
 170
 171 isa_ok($ii->employees->[1], 'Employee');
 172 isa_ok($ii->employees->[1], 'Person');
 173
 174 is($ii->employees->[1]->first_name, 'Tommy', '... got the right first name');
 175 is($ii->employees->[1]->last_name, 'Lee', '... got the right last name');
 176 ok(!$ii->employees->[1]->has_middle_initial, '... no middle initial');
 177 is($ii->employees->[1]->middle_initial, undef, '... got the right middle initial value');
 178 is($ii->employees->[1]->full_name, 'Tommy Lee', '... got the right full name');
 179 is($ii->employees->[1]->title, 'Vice President / Senior Developer', '... got the right title');
 180 is($ii->employees->[1]->company, $ii, '... got the right company');
 181 ok(isweak($ii->employees->[1]->{company}), '... the company is a weak-ref');
 182
 183 isa_ok($ii->employees->[1]->address, 'Address');
 184 is($ii->employees->[1]->address->city, 'New York', '... got the right city');
 185 is($ii->employees->[1]->address->state, 'NY', '... got the right state');
 186
 187 # employee #3
 188
 189 isa_ok($ii->employees->[2], 'Employee');
 190 isa_ok($ii->employees->[2], 'Person');
 191
 192 is($ii->employees->[2]->first_name, 'Stevan', '... got the right first name');
 193 is($ii->employees->[2]->last_name, 'Little', '... got the right last name');
 194 ok($ii->employees->[2]->has_middle_initial, '... got middle initial');
 195 is($ii->employees->[2]->middle_initial, 'C', '... got the right middle initial value');
 196 is($ii->employees->[2]->full_name, 'Stevan C. Little', '... got the right full name');
 197 is($ii->employees->[2]->title, 'Senior Developer', '... got the right title');
 198 is($ii->employees->[2]->company, $ii, '... got the right company');
 199 ok(isweak($ii->employees->[2]->{company}), '... the company is a weak-ref');
 200
 201 isa_ok($ii->employees->[2]->address, 'Address');
 202 is($ii->employees->[2]->address->city, 'Madison', '... got the right city');
 203 is($ii->employees->[2]->address->state, 'CT', '... got the right state');
 204
 205 # employee #4
 206
 207 isa_ok($ii->employees->[3], 'Employee');
 208 isa_ok($ii->employees->[3], 'Person');
 209
 210 is($ii->employees->[3]->first_name, 'Rob', '... got the right first name');
 211 is($ii->employees->[3]->last_name, 'Kinyon', '... got the right last name');
 212 ok(!$ii->employees->[3]->has_middle_initial, '... got middle initial');
 213 is($ii->employees->[3]->middle_initial, undef, '... got the right middle initial value');
 214 is($ii->employees->[3]->full_name, 'Rob Kinyon', '... got the right full name');
 215 is($ii->employees->[3]->title, 'Developer', '... got the right title');
 216 is($ii->employees->[3]->company, $ii, '... got the right company');
 217 ok(isweak($ii->employees->[3]->{company}), '... the company is a weak-ref');
 218
 219 isa_ok($ii->employees->[3]->address, 'Address');
 220 is($ii->employees->[3]->address->city, 'Marysville', '... got the right city');
 221 is($ii->employees->[3]->address->state, 'OH', '... got the right state');
 222
 223 ## check some error conditions for the subtypes
 224
 225 dies_ok {
 226     Address->new(street => {}),
 227 } '... we die correctly with bad args';
 228
 229 dies_ok {
 230     Address->new(city => {}),
 231 } '... we die correctly with bad args';
 232
 233 dies_ok {
 234     Address->new(state => 'British Columbia'),
 235 } '... we die correctly with bad args';
 236
 237 lives_ok {
 238     Address->new(state => 'Connecticut'),
 239 } '... we live correctly with good args';
 240
 241 dies_ok {
 242     Address->new(zip_code => 'AF5J6$'),
 243 } '... we die correctly with bad args';
 244
 245 lives_ok {
 246     Address->new(zip_code => '06443'),
 247 } '... we live correctly with good args';
 248
 249 dies_ok {
 250     Company->new(employees => [ Person->new ]),
 251 } '... we die correctly with good args';
 252
 253 lives_ok {
 254     Company->new(employees => []),
 255 } '... we live correctly with good args';
 256