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');
}
}