POP Documentation : LINK CLASSES
----------------- ------------
This example uses a 3-way link between 3 objects of the same type (Foo::Person).
The example is a "marriage link" describing a marriage of two people, and it
also maintains the officiater of the marriage (e.g. justice of peace). It also
includes an attribute of wedding date.
Here is the pox for the "link_marriage" class. Note the following:
1. The class has a 'type' parameter which is set to 'link'
2. The class includes attributes and participants. Participant is
just another attribute but it a) must be an object and b) it means the
object is part of the link.
<class name='Marriage' abbr='lkmar' type='link'>
Sample link class; connects three people together in holy matrimony
<participant name='husband' type='Foo::Person'>
Husband
</participant>
<participant name='wife' type='Foo::Person'>
Wife
</participant>
<participant name='official' type='Foo::Person'>
Who officiated the marriage
</participant>
<attribute name='wedding_dt' abbr='when' type='numeric(11,0)'>
When this marriage occured
</attribute>
</class>
# poxdb will generate the following things, more or less:
create table lkmar
pid pid_type not null primary key, # The pid of the link object
husband pid_type,
wife pid_type,
official pid_type,
wed_dt char(11,0)
)
# Unlike normal classes, it will create indexes on all participant columns
# to get at them fast.
create index i_husband on lkmar(husband);
create index i_wife on lkmar(wife);
create index i_official on lkmar(official);
# poxperl will generate the following class code for a link class
Foo::Marriage
...
sub initialize {
my $this = shift;
$this->{'husband'} = \do{my $a};
$this->{'wife'} = \do{my $a};
$this->{'official'} = \do{my $a};
$this->{'wed_dt'} = '';
}
=head2 CLASS METHOD
Title: Foo::Marriage::all_with_husband
Desc: Returns list of Marriage objects that have the given
Foo::Person as a husband
=cut
sub all_with_husband {
my($type, $obj) = @_;
return map {$type->new($_)}
$type->all({'where' => [['husband', '=', $obj]]});
}
=head2 PARTICPANT
Title: Foo::Marriage::husband
Desc: Husband
=cut
sub husband {
my $this = shift;
if (@_) {
my $obj = shift;
unless (ref($obj) && $obj->isa('Foo::Person')) {
croak "[$obj] is not a Foo::Person";
}
$this->{'husband'} = \$obj;
}
${$this->{'husband'}};
}
... # same for wife and official, regular stuff for wedding_dt
# here are some handmade methods in the marriage object. Note that
# one _could_ put these methods in the Person class, but really, the
# semantics of the marriage link should be maintained in the marriage
# class itself. These, then, are class methods.
sub is_married {
my($type, $person) = @_;
$type = ref $type || $type;
return $type->all_with_wife($person) ||
$type->all_with_husband($person);
}
sub is_bigomist {
my($type, $person) = @_;
$type = ref $type || $type;
return $type->all_with_husband($person) > 1;
}