The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;
use Test::More;
BEGIN{
    eval 'use Regexp::Common; use Locale::US;';
    if ($@) {
        plan skip_all => 'Regexp::Common & Locale::US required for this test';
    }
    else{
        plan 'no_plan';
    }
}

use Test::Exception;
$| = 1;



# =begin testing SETUP
BEGIN {
    eval 'use Regexp::Common; use Locale::US;';
    if ($@) {
        plan skip_all => 'Regexp::Common & Locale::US required for this test';
    }
}



# =begin testing SETUP
{

  package Address;
  use Mouse;
  use Mouse::Util::TypeConstraints;

  use Locale::US;
  use Regexp::Common 'zip';

  my $STATES = Locale::US->new;
  subtype 'USState'
      => as Str
      => where {
             (    exists $STATES->{code2state}{ uc($_) }
               || exists $STATES->{state2code}{ uc($_) } );
         };

  subtype 'USZipCode'
      => as Value
      => where {
             /^$RE{zip}{US}{-extended => 'allow'}$/;
         };

  has 'street'   => ( is => 'rw', isa => 'Str' );
  has 'city'     => ( is => 'rw', isa => 'Str' );
  has 'state'    => ( is => 'rw', isa => 'USState' );
  has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );

  package Company;
  use Mouse;
  use Mouse::Util::TypeConstraints;

  has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
  has 'address'   => ( is => 'rw', isa => 'Address' );
  has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );

  sub BUILD {
      my ( $self, $params ) = @_;
      if ( @{ $self->employees || [] } ) {
          foreach my $employee ( @{ $self->employees } ) {
              $employee->employer($self);
          }
      }
  }

  after 'employees' => sub {
      my ( $self, $employees ) = @_;
      if ($employees) {
          foreach my $employee ( @{$employees} ) {
              $employee->employer($self);
          }
      }
  };

  package Person;
  use Mouse;

  has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
  has 'last_name'  => ( is => 'rw', isa => 'Str', required => 1 );
  has 'middle_initial' => (
      is        => 'rw', isa => 'Str',
      predicate => 'has_middle_initial'
  );
  has 'address' => ( is => 'rw', isa => 'Address' );

  sub full_name {
      my $self = shift;
      return $self->first_name
          . (
          $self->has_middle_initial
          ? ' ' . $self->middle_initial . '. '
          : ' '
          ) . $self->last_name;
  }

  package Employee;
  use Mouse;

  extends 'Person';

  has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
  has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );

  override 'full_name' => sub {
      my $self = shift;
      super() . ', ' . $self->title;
  };
}



# =begin testing
{
{
    package Company;

    sub get_employee_count { scalar @{(shift)->employees} }
}

use Scalar::Util 'isweak';

my $ii;
lives_ok {
    $ii = Company->new(
        {
            name    => 'Infinity Interactive',
            address => Address->new(
                street   => '565 Plandome Rd., Suite 307',
                city     => 'Manhasset',
                state    => 'NY',
                zip_code => '11030'
            ),
            employees => [
                Employee->new(
                    first_name => 'Jeremy',
                    last_name  => 'Shao',
                    title      => 'President / Senior Consultant',
                    address =>
                        Address->new( city => 'Manhasset', state => 'NY' )
                ),
                Employee->new(
                    first_name => 'Tommy',
                    last_name  => 'Lee',
                    title      => 'Vice President / Senior Developer',
                    address =>
                        Address->new( city => 'New York', state => 'NY' )
                ),
                Employee->new(
                    first_name     => 'Stevan',
                    middle_initial => 'C',
                    last_name      => 'Little',
                    title          => 'Senior Developer',
                    address =>
                        Address->new( city => 'Madison', state => 'CT' )
                ),
            ]
        }
    );
}
'... created the entire company successfully';
isa_ok( $ii, 'Company' );

is( $ii->name, 'Infinity Interactive',
    '... got the right name for the company' );

isa_ok( $ii->address, 'Address' );
is( $ii->address->street, '565 Plandome Rd., Suite 307',
    '... got the right street address' );
is( $ii->address->city,     'Manhasset', '... got the right city' );
is( $ii->address->state,    'NY',        '... got the right state' );
is( $ii->address->zip_code, 11030,       '... got the zip code' );

is( $ii->get_employee_count, 3, '... got the right employee count' );

# employee #1

isa_ok( $ii->employees->[0], 'Employee' );
isa_ok( $ii->employees->[0], 'Person' );

is( $ii->employees->[0]->first_name, 'Jeremy',
    '... got the right first name' );
is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
is( $ii->employees->[0]->middle_initial, undef,
    '... got the right middle initial value' );
is( $ii->employees->[0]->full_name,
    'Jeremy Shao, President / Senior Consultant',
    '... got the right full name' );
is( $ii->employees->[0]->title, 'President / Senior Consultant',
    '... got the right title' );
is( $ii->employees->[0]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[0]->{employer} ),
    '... the company is a weak-ref' );

isa_ok( $ii->employees->[0]->address, 'Address' );
is( $ii->employees->[0]->address->city, 'Manhasset',
    '... got the right city' );
is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );

# employee #2

isa_ok( $ii->employees->[1], 'Employee' );
isa_ok( $ii->employees->[1], 'Person' );

is( $ii->employees->[1]->first_name, 'Tommy',
    '... got the right first name' );
is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
is( $ii->employees->[1]->middle_initial, undef,
    '... got the right middle initial value' );
is( $ii->employees->[1]->full_name,
    'Tommy Lee, Vice President / Senior Developer',
    '... got the right full name' );
is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
    '... got the right title' );
is( $ii->employees->[1]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[1]->{employer} ),
    '... the company is a weak-ref' );

isa_ok( $ii->employees->[1]->address, 'Address' );
is( $ii->employees->[1]->address->city, 'New York',
    '... got the right city' );
is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );

# employee #3

isa_ok( $ii->employees->[2], 'Employee' );
isa_ok( $ii->employees->[2], 'Person' );

is( $ii->employees->[2]->first_name, 'Stevan',
    '... got the right first name' );
is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
is( $ii->employees->[2]->middle_initial, 'C',
    '... got the right middle initial value' );
is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
    '... got the right full name' );
is( $ii->employees->[2]->title, 'Senior Developer',
    '... got the right title' );
is( $ii->employees->[2]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[2]->{employer} ),
    '... the company is a weak-ref' );

isa_ok( $ii->employees->[2]->address, 'Address' );
is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );

# create new company

my $new_company
    = Company->new( name => 'Infinity Interactive International' );
isa_ok( $new_company, 'Company' );

my $ii_employees = $ii->employees;
foreach my $employee (@$ii_employees) {
    is( $employee->employer, $ii, '... has the ii company' );
}

$new_company->employees($ii_employees);

foreach my $employee ( @{ $new_company->employees } ) {
    is( $employee->employer, $new_company,
        '... has the different company now' );
}

## check some error conditions for the subtypes

dies_ok {
    Address->new( street => {} ),;
}
'... we die correctly with bad args';

dies_ok {
    Address->new( city => {} ),;
}
'... we die correctly with bad args';

dies_ok {
    Address->new( state => 'British Columbia' ),;
}
'... we die correctly with bad args';

lives_ok {
    Address->new( state => 'Connecticut' ),;
}
'... we live correctly with good args';

dies_ok {
    Address->new( zip_code => 'AF5J6$' ),;
}
'... we die correctly with bad args';

lives_ok {
    Address->new( zip_code => '06443' ),;
}
'... we live correctly with good args';

dies_ok {
    Company->new(),;
}
'... we die correctly without good args';

lives_ok {
    Company->new( name => 'Foo' ),;
}
'... we live correctly without good args';

dies_ok {
    Company->new( name => 'Foo', employees => [ Person->new ] ),;
}
'... we die correctly with good args';

lives_ok {
    Company->new( name => 'Foo', employees => [] ),;
}
'... we live correctly with good args';
}




1;