view release on metacpan or  search on metacpan

t/meta/array_storage/association.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 41;
    
{
    package Class;
    use Abstract::Meta::Class ':all'; storage_type 'Array';
    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'; storage_type 'Array';
    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'; storage_type 'Array';
    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'; storage_type 'Array';
    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)');
    }