1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
package CD;
our $c;
use base "Class::Accessor::Assert";
__PACKAGE__->mk_accessors(qw(
artist=CD::Artist title publishdate=Time::Piece songs=ARRAY
));
package CD::Compilation;
use base 'CD';
package CD::Song;
use base 'Class::Accessor';
__PACKAGE__->mk_accessors("name");
package CD::Artist;
use base 'Class::Accessor::Assert';
__PACKAGE__->mk_accessors(qw( name popularity cds=Set::Object ));
package CD::Person;
use base 'CD::Artist';
__PACKAGE__->mk_accessors(qw(gender haircolor birthdate=Time::Piece));
package CD::Band;
use base 'CD::Artist';
__PACKAGE__->mk_accessors( qw( members=Set::Object
creationdate=Time::Piece
enddate=Time::Piece ));
# for running tests, we keep a count of objects created
BEGIN {
for my $package ( qw(CD CD::Song CD::Artist CD::Person CD::Band) ) {
sub new { $CD::c++; my $invocant = shift; $invocant->SUPER::new(@_); }
sub DESTROY { --$CD::c; }
}
}
# This dispatching isn't necessary because we use inheritance
# # Dispatch "band" accessors if it's a band
# for my $accessor (qw(members creationdate breakupdate)) {
# *$accessor = sub {
# my $self = shift;
# return $self->band->$accessor(@_) if $self->band
# };
# }
# # And dispatch "person" accessors if it's a person
# for my $accessor (qw(gender haircolor birthdate)) {
# *$accessor = sub {
# my $self = shift;
# return $self->person->$accessor(@_) if $self->person
# };
# }
1;
|
