t/000-recipes/moose_cookbook_basics_recipe4.t

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