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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
|
package Person;
use overload
'""' => 'stringify',
'==' => 'equals',
'!=' => 'notequals',
fallback => 1;
sub new
{
++$n;
my $type = shift;
my $self = bless { @_ }, $type;
$self->{firstname} ||= "";
$self->{name} ||= "";
return $self;
}
sub DESTROY
{
--$n;
}
sub populate
{
no strict 'vars';
$homer = new Person( firstname => 'Homer', name => 'Simpson' );
$marge = new Person( firstname => 'Marge', name => 'Simpson' );
$bart = new Person( firstname => 'Bart', name => 'Simpson' );
$lisa = new Person( firstname => 'Lisa', name => 'Simpson' );
$maggie = new Person( firstname => 'Maggie', name => 'Simpson' );
@simpsons = ($homer, $marge, $bart, $lisa, $maggie);
$burns = new Person( firstname => 'Montgomery', name => 'Burns' );
$skinner = new Person( firstname => 'Seymour', name => 'Skinner' );
$patty = new Person( firstname => 'Patty', name => 'Bouvier' );
$selma = new Person( firstname => 'Selma', name => 'Bouvier' );
$n;
}
sub exterminate
{
no strict 'vars';
undef $homer;
undef $marge;
undef $bart;
undef $lisa;
undef $maggie;
undef @simpsons;
undef $burns;
undef $skinner;
undef $patty;
undef $selma;
$n;
}
sub same
{
my ($l1, $l2) = @_;
my @l1 = sort { $a->{firstname} cmp $b->{firstname} } @$l1;
my @l2 = sort { $a->{firstname} cmp $b->{firstname} } @$l2;
foreach (@l1) { return 'not ' unless $_ eq shift @l2 }
'';
}
sub stringify
{
my $self = shift;
return "$self->{firstname} $self->{name}";
}
sub equals
{
my $a = shift;
my $b = shift;
return ( $a->{firstname} eq $b->{firstname} &&
$a->{name} eq $b->{name} )
}
sub notequals {
!equals(@_);
}
1;
|