The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More tests => 41;
    
{
    package Class;
    use Abstract::Meta::Class ':all';
    has '$.to_one'  => (associated_class => 'AssociatedClass');
    has '@.ordered' => (associated_class => 'AssociatedClass');
    has '%.to_many' => (associated_class => 'AssociatedClass', index_by => 'a', item_accessor => 'association');
}

{
    package AssociatedClass;
    use Abstract::Meta::Class ':all';
    has '$.a';
}

{
    eval {Class->new(to_one => bless({},'main') )};
    like($@, qr{to_one must be of the AssociatedClass type},  'should catch invalid assocated_class - to one type');
    my $obj = Class->new(to_one => AssociatedClass->new);
    isa_ok($obj, 'Class');
    ok($obj->has_to_one, 'should have value');
    $obj->reset_to_one;
    ok(! $obj->has_to_one, 'should have reset value');
}

{
    eval {Class->new(ordered => [bless({},'main')])};
    like($@, qr{ordered must be of the AssociatedClass type},  'should catch invalid assocated_class - ordered type' );
    my $obj = Class->new(ordered => [AssociatedClass->new]);
    isa_ok($obj, 'Class');
    ok($obj->has_ordered, 'should have value');
    $obj->reset_ordered;
    ok(! $obj->has_ordered, 'should have reset value');
}

{
    eval {Class->new(to_many => [bless({},'main')])};
    like($@, qr{to_many must be of the AssociatedClass type},  'should catch invalid assocated_class - to many type');
    my @associations = (AssociatedClass->new(a => '002'), AssociatedClass->new(a => '302'));
    my $obj = Class->new(to_many => \@associations);
    isa_ok($obj, 'Class');
    my @exp_association = values %{$obj->to_many};
    is_deeply([sort @associations], [sort @exp_association], 'should have associations');

    is($obj->association('002'), $associations[0], 'should have indexed association');
    is($obj->association('302'), $associations[1], 'should have indexed association');

    ok($obj->has_to_many, 'should have value');
    $obj->reset_to_many;
    ok(! $obj->has_to_many, 'should have reset value');

}


{
    package ClassA;
    use Abstract::Meta::Class ':all';
    has '$.to_oneA'  => (associated_class => 'AssociatedClassA', the_other_end => 'classAA' );
    has '$.to_one'  => (associated_class => 'AssociatedClassA', the_other_end => 'classA' );
    has '@.ordered' => (associated_class => 'AssociatedClassA');
    has '%.to_many' => (associated_class => 'AssociatedClassA', index_by => 'a', item_accessor => 'association');
}


{
    package AssociatedClassA;
    use Abstract::Meta::Class ':all';
    has '$.a';
    has '$.ordered_ClassA' => (associated_class => 'ClassA', the_other_end => 'ordered');
    has '$.to_many_ClassA' => (associated_class => 'ClassA', the_other_end => 'to_many');
    
    has '$.classAA';
    my $a1 = AssociatedClassA->new(a => 1);
    my $a2 = AssociatedClassA->new(a => 2);
    ;
    eval { ClassA->new(to_oneA => $a1) };
    ::like($@, qr{invalid definition for ClassA::to_oneA - associatied class not defined on AssociatedClassA::classAA.+},
           'should catch invalid definition on the other end attribute');

    
    eval { ClassA->new(to_one => $a1) };
    ::like($@, qr{missing other end attribute on AssociatedClassA::classA.+}, 'shuould catch the invalid other end definition');
    has '$.classA' => (associated_class => 'ClassA', the_other_end => 'to_one');
    
    {
        my $clazz = ClassA->new(to_one => $a1);
        ::is($a1, $clazz->to_one, 'should associate');
        $clazz->to_one($a2);
        ::is($a2, $clazz->to_one, 'should deassociate the other end (scalar)');
        ::is($a2->classA, $clazz, 'should associate the other end (scalar)');
    }
    
    {
        my $clazz = ClassA->new(ordered => [$a1, $a2]);
        ::ok((grep {$_ eq $a1} $clazz->ordered), 'should associate the other end (array)');
    }

    {
        my $clazz = ClassA->new(to_many => [$a1, $a2]);
        ::ok((grep {$_ eq $a1} values %{$clazz->to_many}), 'should associate the other end (hash)');
    }


        #THE OTHER END BIDIRECTIONAL ASSOCIATION, DEASSOCIATION
    {
        package Master;
        use Abstract::Meta::Class ':all';
        has '$.name' => (required => 1);
        has '%.details' => (
            associated_class => 'Detail',
            index_by         => 'id',
            item_accessor    => 'detail',
            the_other_end    => 'master',
        );
    }

    {
        package Detail;
        use Abstract::Meta::Class ':all';
        has '$.id'     => (required => 1);
        has '$.master' => (
            associated_class => 'Master',
            the_other_end    => 'details'
        );
    }
    
    {
        my @details = (Detail->new(id => 1), Detail->new(id => 2,), Detail->new(id => 3));
        my $master = Master->new(name => 'master', details => [@details]);
        $master->remove_details($details[1]);
        ::ok(! $details[1]->master, 'should deassociate relationship');
        my $detauls = $master->details;
        ::is_deeply($detauls, {1=> $details[0], 3 => $details[-1]}, 'should remove details');
        $master->remove_details(3);
        ::ok(! $details[2]->master, 'should deassociate relationship');
    }
    
    
    
    

    {    
        my @details  = (
            Detail->new(id => 1),
            Detail->new(id => 2),
            Detail->new(id => 3),
        );
        
        my $master = Master->new(name    => 'foo', details => [@details]);
        ::is($details[$_]->master, $master, "should associate by biderectional def") for (0 .. 2);
        
        my $master2 = Master->new(name    => 'foo2');
        $details[-1]->set_master($master2);
        my @detail1 = values %{$master->details};
        my @details_ids1 = keys %{$master->details};
        
        ::is_deeply([sort @detail1], [sort @details[0 .. 1]], 'should have 2 details elements');
        ::is_deeply([sort @details_ids1], [1,2], 'should have 2 details index');
        ::is($master2->detail(3), $details[-1], "should have details");
    }



        #THE OTHER END BIDIRECTIONAL ASSOCIATION, DEASSOCIATION
    {
        package MasterA;
        use Abstract::Meta::Class ':all';
        has '$.name' => (required => 1);
        has '@.details' => (
            associated_class => 'DetailA',
            index_by         => 'id',
            item_accessor    => 'detail',
            the_other_end    => 'master',
        );
    }

    {
        package DetailA;
        use Abstract::Meta::Class ':all';
        has '$.id'     => (required => 1);
        has '$.master' => (
            associated_class => 'MasterA',
            the_other_end    => 'details'
        );
    }

    {    
        my @details  = (
            DetailA->new(id => 1),
            DetailA->new(id => 2),
            DetailA->new(id => 3),
        );
        
        my $master = MasterA->new(name    => 'foo', details => [@details]);
        ::is($details[$_]->master, $master, "should associate by biderectional def") for (0 .. 2);
        
        my $master2 = MasterA->new(name    => 'foo2');
        $details[-1]->set_master($master2);
        my @detail1 = $master->details;
        
        ::is_deeply(\@detail1, [@details[0 .. 1]], 'should have 2 details elements');
        ::is($master2->detail(0), $details[-1], "should have details");
        
        
        
        $master->cleanup;
        ::is($_->master, undef, 'should be deassociiated') for @details[0 .. 1];
        
        my $details = $master->details;
        ::is_deeply($details, [], 'should not have details association');
    }


    {    
        my @details  = (
            DetailA->new(id => 1),
            DetailA->new(id => 2),
            DetailA->new(id => 3),
        );
        
        my $master = MasterA->new(name    => 'foo', details => [@details]);
        $master->remove_details($details[1]);
        ::ok($details[1]->master, 'should deassociate the other end');
        my $details = $master->details;
        ::is_deeply($details, [$details[0], $details[-1]], 'should remove object');
    }

}