use strict;
use warnings;
 
my $world = World->new();
my $current = $world->start();
print $current->describe_room();
 
$current = $current->exit("north");
print $current->describe_room();
 
package World;
 
sub new
{
   my ($class) = @_;
 
   my $self = bless {}, $class;
 
 
   while(<main::DATA>)
   {
     chomp;
     my ($room_name,$start,$north,$south,$east,$west) = split /,/;
 
     my $room = $room_name->instance();
     $room->add_exit("north",$north->instance()) if $north;
     $room->add_exit("south",$south->instance()) if $south;
     $room->add_exit("east",$east->instance()) if $east;
     $room->add_exit("west",$west->instance()) if $west;
     $room->description($room_name);
     $self->start($room) if $start;
   }
 
   return $self;
}
 
 
sub start
{
    my ($self, $start ) = @_;
 
    if ( defined $start )
    {
       $self->{_start_room} = $start;
    }
 
    return $self->{_start_room};
}
 
package Room;
 
use base qw(Class::Singleton);
 
my @exits = qw(north south east west);
 
sub add_exit
{
   my ( $self,$direction, $room ) = @_;
 
   $self->{_exits}->{$direction} = $room;
}
 
sub exit
{
   my ($self, $direction ) = @_;
 
   return exists $self->{_exits}->{$direction} ?
                 $self->{_exits}->{$direction} : undef;
}
 
sub exits
{
   my ($self) = @_;
 
   return keys %{$self->{_exits}};
}
 
sub describe_room
{
    my ($self) = @_;
 
    my $description = "You are in the " . $self->description() ."\n";
    $description .= "There are exits:\n";
    foreach my $exit ( $self->exits() )
    {
      $description .= "To the $exit going to the "
                      . $self->exit($exit)->description() . "\n";
    }
 
    return $description;
}
 
sub description
{
   my ( $self, $description ) = @_;
 
   if (defined $description)
   {
      $self->{_description} = $description;
   }
   return $self->{_description};
}
 
sub DESTROY {}
 
package UNIVERSAL;
 
sub DESTROY {}
 
sub AUTOLOAD
{
   my ($class, @args) = @_;
 
   our $AUTOLOAD;
 
   (my $method = $AUTOLOAD) =~ s/.*:://;
 
 
 
   no strict 'refs';
 
   push @{"${class}::ISA"},'Room' ;
 
   $class->$method( @args);
}
 
package main;
 
__END__
Hall,1,Store,,,
Store,0,,Hall,Cupboard,Corridor
Cupboard,0,,,,Store
Corridor,0,,,Store,