t/000_recipes/moose_cookbook_basics_recipe4.t

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