package OOPerlTest::Personal::Person;
use MooseX::Declare;
#class OOPerlTest::Personal::Person with
OOPerlTest::Personal::Interface::Person {
class OOPerlTest::Personal::Person {
#use MooseX::StrictConstructor;
use OOPerlTest::Types qw(ValidDateManip);
#+name : string [1]
has 'name' => (
is => 'rw',
isa => 'Str',
required => 1,
);
#+dateOfBirth : string [1]
has 'dateOfBirth' => (
is => 'rw',
isa => ValidDateManip,
required => 1,
);
#+alias : string [0..1]
has 'alias' => (
is => 'rw',
isa => 'Str',
required => 0,
);
}
__END__
package OOPerlTest::Personal::Person::Employee;
use MooseX::Declare;
class OOPerlTest::Personal::Person::Employee extends
OOPerlTest::Personal::Person {
use Carp;
use Date::Manip;
use OOPerlTest::Personal::Person;
use OOPerlTest::Types qw(ValidDateManip WorkUnit);
sub BUILDARGS {
my ($self, %params) = @_;
#use Data::Dumper;
#print Dumper(\%params);
return \%params;
}
#+hireDate : string [1]
has 'hireDate' => (
is => 'rw',
isa => ValidDateManip,
required => 1,
trigger => \&_make_sure_hiredate_is_after_dob,
);
sub _make_sure_hiredate_is_after_dob {
my ($self, $hireDate) = @_;
$self->dateOfBirth or return;
my $d1 = ParseDate($self->dateOfBirth);
my $d2 = ParseDate($hireDate);
my $flag = Date_Cmp($d1, $d2);
if ($flag == 1) {
croak "dateOfBirth must be before hireDate!";
}
}
}
1;
__END__
package OOPerlTest::Personal::Person::Employee::Manager;
use MooseX::Declare;
class OOPerlTest::Personal::Person::Employee::Manager extends
OOPerlTest::Personal::Person::Employee {
use Data::Dumper;
use Date::Manip;
use OOPerlTest::Personal::Person::EmployeeFactory;
use OOPerlTest::Types qw(Person WorkUnit Employee);
has 'employees' => (
is => 'rw',
isa => 'ArrayRef[OOPerlTest::Personal::Person::Employee]',
required => 0,
);
has 'workUnitsProcessed' => (
is => 'rw',
isa => 'Int',
required => 0,
);
has 'employee_factory' => (
is => 'rw',
isa => 'OOPerlTest::Personal::Person::EmployeeFactory',
required => 1,
default => sub {
OOPerlTest::Personal::Person::EmployeeFactory->new() },
lazy => 1,
);
has 'rejected' => (
is => 'rw',
isa => 'Int',
required => 1,
default => sub { 0 },
lazy => 1,
);
has 'completed' => (
is => 'rw',
isa => 'Int',
required => 1,
default => sub { 0 },
lazy => 1,
);
#+Hire(person : Person) : Employee
method Hire (Person $person!) {
#print Dumper($person);
#my $employee = $self->employee_factory->new_from_person($person);
# THIS IS BROKEN!!!!
my $employee = OOPerlTest::Personal::Person::Employee->new(
name => 'Bill Gates',
alias => 'Mr Evil',
dateOfBirth => '05/27/1965',
hireDate => '01/01/2010',
);
# the object returned ISA Person and Employee but has none of the
Person attributes!
die unless $employee->isa('OOPerlTest::Personal::Person');
die unless $employee->isa('OOPerlTest::Personal::Person::Employee');
#print Dumper($employee);
return $employee;
}
}
1;
__END__
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl
OOPerlTest-Personal.t'
#########################
use Test::More;
BEGIN { plan tests => 21 };
my $class_person = 'OOPerlTest::Personal::Person';
my $class_employee = 'OOPerlTest::Personal::Person::Employee';
my $class_manager = 'OOPerlTest::Personal::Person::Employee::Manager';
my $class_workUnit = 'OOPerlTest::Personal::WorkUnit';
use_ok($class_person);
use_ok($class_employee);
use_ok($class_manager);
use_ok($class_workUnit);
{
my $manager = $class_manager->new
(
name => 'Rafael Rodriguez',
alias => 'rafe',
dateOfBirth => '10/24/1970',
hireDate => '01/01/2010'
);
my $person = $class_person->new(
name => 'Jack Smith',
alias => 'Jackie',
dateOfBirth => '07/17/1980',
);
isa_ok($person, $class_person);
cmp_ok($person->name, 'eq', 'Jack Smith', 'GOOD');
cmp_ok($person->alias, 'eq', 'Jackie', 'GOOD');
cmp_ok($person->dateOfBirth, 'eq', '07/17/1980', 'GOOD');
my $employee = $manager->Hire($person);
isa_ok($employee, $class_person);
isa_ok($employee, $class_employee);
cmp_ok($employee->name, 'eq', 'Jack Smith', 'BAD');
cmp_ok($employee->alias, 'eq', 'Jackie', 'BAD');
cmp_ok($employee->dateOfBirth, 'eq', '07/17/1980', 'BAD');
}
Rick Apichairuk
