RE: Inheritance not working for some weird reason.

[Rick Apichairuk]

> -----Original Message----- 
> Heh, I apologize for being overly cranky yesterday. Please send the left pinky
> to the TPF to hold so we can auction it off at YAPC::NA.
> 

No problem, I get cranky too. Pinky is on it's way. 
 
> MooseX::Declare is I think confusing things a bit yes. If however you can get 
> a
> cleaned up example that exhibits the behavior your seeing, I'd be happy (and
> promise less cranky) to take a look at it.
> 
> -Chris

I've cleaned up the code as much as I could. I've included the source code 
here. The classes are meant to be written out to separate files. You should see 
that tests 6,7, and 8 fail.

Thanks in advance for anyone who looks into this!

use Test::More;
BEGIN { plan tests => 9 };

my $class_person = 'Person';
my $class_employee = 'Employee';
my $class_manager = 'Manager';

use_ok($class_person);
use_ok($class_employee);
use_ok($class_manager);

{
    my $manager = Manager->new(
        name => 'Rick Apichairuk',
        alias => 'Rickie Speedmaster',
        dateOfBirth => '01/01/1985',
        hireDate => '01/01/2000',
    );  

    my $employee = $manager->Broken(
        name => 'Bill Gates',
        alias => 'Mr Evil',
        dateOfBirth => '05/27/1965',
        hireDate => '01/01/2010',
    );  

    isa_ok($employee, $class_person);
    isa_ok($employee, $class_employee);

    cmp_ok($employee->name, 'eq', 'Bill Gates', 'BAD');
    cmp_ok($employee->alias, 'eq', 'Mr Evil', 'BAD');
    cmp_ok($employee->dateOfBirth, 'eq', '05/27/1965', 'BAD');
    cmp_ok($employee->hireDate, 'eq', '01/01/2010', 'KINDA GOOD - This is the 
only attribute that gets set!');
}


package Types;

use strict;
use warnings;


# predeclare our own types
use MooseX::Types -declare => [
    qw( 
          TypeWorkUnit
          TypeWorkUnitStatus
          TypeValidDateManip
          TypePerson
          TypeEmployee
      )
];

# import builtin types
use MooseX::Types::Moose qw/Undef Int Str/;
use Date::Manip;

subtype TypeValidDateManip,
    as Str,
    where { Date::Manip::ParseDate($_) // 0 }, message { "Failed to be parsed 
by Date::Manip" };

subtype TypeWorkUnitStatus, 
    as Str,
    where {
        (   
                $_ eq 'NotStarted'
            or  $_ eq 'Started'
            or  $_ eq 'Completed'
            or  $_ eq 'Rejected'
        )   
    }, message { "Invalid WorkUnitStatus" };


require WorkUnit;

class_type TypeWorkUnit,   { class => 'WorkUnit' };

require Person;

class_type TypePerson,     { class => 'Person' };

require Employee;

class_type TypeEmployee,   { class => 'Employee' };

1;

__END__

use MooseX::Declare;

class Employee extends Person {
    use Carp;
    use Date::Manip;
    use Person;
    use Types qw(TypeValidDateManip);

    sub BUILDARGS {
        my ($self, %params) = @_; 

        #use Data::Dumper;
        #print Dumper(\%params);

        return \%params;
    }   


    #+hireDate : string [1]
    has 'hireDate' => (
        is       => 'rw',
        isa      => TypeValidDateManip,
        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__

class Manager extends Employee {
    use Data::Dumper;
    use Date::Manip;
    use Types qw(TypePerson TypeEmployee);

    has 'employees' => (
        is       => 'rw',
        isa      => 'ArrayRef[TypeEmployee]',
        required => 0,
    );  

    has 'workUnitsProcessed' => (
        is       => 'rw',
        isa      => 'Int',
        required => 0,
    );  

    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,
    );  

    method Broken (Str :$name!, Str :$alias!, Str :$dateOfBirth!, Str 
:$hireDate!) {
        my $employee = Employee->new(
                    name => $name,
                    alias => $alias,
                    dateOfBirth => $dateOfBirth,
                    hireDate => $hireDate,
        );  

        # the object returned ISA Person and Employee but has none of the 
Person attributes!
        die unless $employee->isa('Person');
        die unless $employee->isa('Employee');

        print Dumper($employee);

        return $employee;
    }   
}

__END__

use MooseX::Declare;

class Person {
    #use MooseX::StrictConstructor;
    use Types qw(TypeValidDateManip);

    has 'name' => (
        is       => 'rw',
        isa      => 'Str',
        required => 1,
    );  

    has 'dateOfBirth' => (
        is       => 'rw',
        isa      => TypeValidDateManip,
        required => 1,
    );  

    has 'alias' => (
        is       => 'rw',
        isa      => 'Str',
        required => 0,
    );  
}

__END__

use MooseX::Declare;

class WorkUnit {
    use Types qw(TypeWorkUnitStatus);

    #+project : string [0..1]
    has 'project' => (
        is       => 'rw',
        isa      => 'Str',
        required => 0,
    );  

    #+task : string [1]
    has 'task' => (
        is       => 'rw',
        isa      => 'Str',
        required => 1,
    );  

    #+status : WorkUnitStatus [1]
    has 'status' => (
        is       => 'rw',
        isa      => TypeWorkUnitStatus,
        required => 1,
    );  

    #+payload : String [0..1]
    has 'payload' => (
        is       => 'rw',
        isa      => 'Str',
        required => 0,
    );  
}

__END__

Rick