The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;

package Sunnydale;
use Test::More;
use Carp;

sub leaktest {
  local $TODO;
  is $SunnydaleObject::population, 0, "Leaktest";
  $SunnydaleObject::population = 0;
}

package SunnydaleObject;
use Data::UUID;

our $population = 0;

use overload '""' => 'as_string';

sub new {
  my $proto = shift;
  ++$population;
  my $self = bless { $proto->defaults, @_ }, $proto;
  $self->init;
  return $self;
}

sub init {
  my $self = shift;
  $self->_oid; # setup an oid.
  return $self;
}

sub defaults { return () }

{
  my $oid_maker;
  sub _oid {
    my $self = shift;
    if (@_) {
      $self->{_oid} = $_[0];
      return $self;
    }
    else {
      $self->{_oid} ||= ($oid_maker ||= Data::UUID->new)->create_str;
    }
  }
}

sub DESTROY {
  --$population
}

package Person;

use base 'SunnydaleObject';

our $VERSION='1'; # so use base doesn't autoload Person.pm

sub as_string { die 'subclass responsibility' }

sub name {
  my $self = shift;
  if (@_) {
    $self->{name} = shift;
    return $self;
  }
  else {
    return $self->{name};
  }
}

package IndividualPerson;

use base 'Person';

sub as_string {
  my $self = shift;

  my $name = $self->name;
  my $first_name = $self->first_name;

  if (defined($name) && defined($first_name)) {
    return "$first_name $name";
  }
  elsif (defined $first_name) {
    return $first_name;
  }
  else {
    return $name;
  }
}

sub has_soul {
  my $self = shift;

  if (@_) {
    $self->{has_soul} = shift;
    return $self;
  }
  else {
    return $self->{has_soul};
  }
}

sub first_name {
  my $self = shift;

  if (@_) {
    $self->{first_name} = shift;
    return $self;
  }
  else {
    return $self->{first_name};
  }
}

package Human;

use base 'IndividualPerson';

sub defaults {
  my $proto = shift;

  return( $proto->SUPER::defaults, has_soul => 1 );
}

package Vampire;

use base 'IndividualPerson';

sub defaults {
  my $proto = shift;
  return ($proto->SUPER::defaults, sire => undef, has_soul => 0);
}

sub sire {
  my $self = shift;
  if (@_) {
    $self->{sire} = shift;
    die "Sire must be a vampire" unless $self->{sire}->isa('Vampire');
    return $self;
  }
  else {
    return $self->{sire};
  }
}

package Demon;

use base 'IndividualPerson';

package CorporatePerson;

use base 'Person';

sub as_string {
  my $self = shift;
  $self->name;
}


package EducationalEstablishment;

use base 'CorporatePerson';

sub defaults {
  my $proto = shift;
  return ($proto->SUPER::defaults, on_hellmouth => undef);
}

package Group;

use base 'CorporatePerson';

sub defaults {
  my $proto = shift;
  return ($proto->SUPER::defaults, members => []);
}

sub members {
  my $self = shift;
  if (@_) {
    @{$self->{members}} = @_;
    return $self;
  }
  else {
    return wantarray ? @{$self->{members}} : $self->{members};
  }
}

1;