package Person;

my $census = 0;
my @o;

sub census {
  return $census;
}

my %permitted = map { $_ => 1 } (qw(NAME AGE SPOUSE));
#                                ('NAME', 'AGE', 'SPOUSE')

sub new {
  my $class = shift;
  my %ARGS = @_;
  for my $k ( keys %ARGS ) {
    croak "Bad key $k" unless $permitted{$k};
  }
  my $self = \%ARGS;
  ++$census;
  push @o, $self;
  my $i = $#o;
  bless \$i => $class;
}

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

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

sub spouse {
  my $i = shift;
  my $self = $o[$$i];
  my $new_spouse_i = shift;
  return $self->{SPOUSE} unless defined $new_spouse_i;

  my $new_spouse = $o[$$new_spouse_i];

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

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

sub as_string {
  my $i = shift;
  my $self = $o[$$i];
  my $spouse = $i->spouse;
  my $t = ref($i) . '  ' . ($i->name || '(unnamed)');
  my $age = $i->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;
}

sub DESTROY {
  my $index = shift;
  undef $o[$$index];
}

1;