package Person;

my $census;

sub census {
  return $census;
}

sub new {
  my ($class, $name, $age, $spouse) = @_;
  my $self = { NAME => $name, AGE => $age, SPOUSE => $spouse };
  ++$census;
  bless $self => $class;
}

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

sub age {
  my $self = shift;
  $self->{AGE} = shift if @_;
  return $self->{AGE};
}

sub spouse {
  my $self = shift;
  my $new_spouse = shift;
  return $self->{SPOUSE} unless defined $new_spouse;

  $self->divorce;
  $new_spouse->divorce;
  $new_spouse->{SPOUSE} = $self;
  $self->{SPOUSE} = $new_spouse;
  return $self->{SPOUSE};
}

sub divorce {
  my $self = shift;
  my $old_spouse = $self->{SPOUSE};
  undef $self->{SPOUSE};
  $old_spouse->divorce if defined $old_spouse;
}  

sub as_string {
  my $self = shift;
  my $spouse = $self->spouse;
  my $t = ref($self) . '  ' . ($self->name || '(unnamed)');
  my $age = $self->age;
  $t .= (defined $age ? " is $age years old" : "has an unknown age");
  $t .= " and is married to " . ($spouse->name || 'someone with no name')
    if defined $spouse;
  return $t;
}

1;