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;