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 'no_plan';
use Test::Fatal;
$| = 1;



# =begin testing SETUP
use Test::Requires {
    'Locale::US'     => '0',
    'Regexp::Common' => '0',
};



# =begin testing SETUP
{

  package Address;
  use Moose;
  use Moose::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 Moose;
  use Moose::Util::TypeConstraints;

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

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

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

  package Person;
  use Moose;

  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 Moose;

  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;
is(
    exception {
        $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' )
                    ),
                ]
            }
        );
    },
    undef,
    '... 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

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

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

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

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

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

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

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

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

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

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




1;