package Person;

my $census = 0;

sub census {
  return $census;
}



sub new {
  my $self = shift;
  my $class = (ref $self) || $self;
  $self = (ref $self) ? {%$self} : {}; 
  delete $self->{SPOUSE};  # not copied
  for (qw(NAME AGE)) {
    my $arg = shift;
    $self->{$_} = $arg if defined $arg;
  }
  ++$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;