package Person;
use Carp;

sub new {
  my ($class, $name, $age, $spouse) = @_;
  my $self = { NAME => $name, AGE => $age, SPOUSE => $spouse };
  if (defined $spouse) {
    if (defined $spouse->spouse) {
      croak "Cannot construct person with already married spouse";
    } else {
      $spouse->{SPOUSE} = $self;
    }
  }
  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;
  if ($self == $new_spouse) {
    croak "Person attempted to marry him/herself";
  }

  $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;