WebLife: peer-to-peer Game of Life

[dash2]

Category:

Fun

Description:

WebLife allows you to run a game of life over the network.

Update: now available as a tar.gz file here

History

I wrote the first version of this over a period of some months. It comprised three parts: a general framework for P2P programming, a specific framework for creating "spaces" using P2P, along with an implementation of a (N-dimensional) space of square/cubic "blocks", and a GoL implementation using this last. It was beautifully designed and architected, very large, and debugged over many hellish hours. It was wiped out by a hard drive crash.

Last month I came back and hacked this together in a few evenings. It is not at all beautiful, but it does the job.

Rationale

(short version:) To build the biggest Game of Life ever.

(long version:) I am self-taught in programming and know nothing about research into P2P and distributed computing. However, it seems to me that the metaphor of "space" provides an interesting way to divide up programming tasks so that they can be accomplished by many computers, when normally those tasks would not be seen as suitable. The basic idea is that the state of each chunk of space (here a square of the GoL map) needs only to talk to its neighbours.

One way to think of it is that each part of the space has an "information cone". Outside this cone, no state of the system can affect the state of the space.

The cone for a single GoL cell looks like this:

   _O_      # my cell at t+1
  |OOO |   # my cell and my neighbours at t

So, extended through history, it looks like this

     o     
    ooo    
   ooooo   
  ooooooo  
 ooooooooo

This means that a square of cells, side n, can communicate with its eight neighbours and create a new square of size n * 3. It can then calculate the next n turns in the GoL. Each turn, cells which are incalculable (because they are on the edge of the calculated area) are discarded. Finally, the square has calculated its new state.

TODO

* I am not certain of the networking code in WebLife::Transport. To avoid problems whereby a lost node makes the whole network sieze up, each node forks a child which listens for messages and relays them to the parent. The parent can then spend a long time sending messages to its neighbours, but will not cause other neighbours to time out. For some reason, syswrite seems to be necessary here. Clarifications welcome.

* A method to provide a specific initial map (currently a random one is created) or to allow peers to provide their own maps on joining.

* Rearchitect the code to separate the "game of life" stuff from the "p2p space" stuff. No policy decisions should be made in the MessageHandler - instead, it should just pass messages on to clients which register an interest in particular message types

* Optimization: speed up the game of life cell calculation by eliminating the ->value method call (maybe put it inside WebLife::Game::Map)

* Optimization 2: compress map data better for sending. See WebLife::Game::Map::as_string and from_string. Suggestions welcome.

* Failure tolerance. At the moment, the game is worthless if a single peer goes down. We could have facilities for peer migration (so that hitting Ctrl+C causes the peer to send itself to the position server, which then finds it a new home where it forks and finds a new port); and for active position resurrection (so if we don't hear from a peer, we assume it has died, and one of the neighbours takes responsibility for resurrecting it using its stored data). This last would require some way to request specific map data from other peers. (At the moment, map data is simply pushed to neighbours when it is ready.)

* Fault tolerance 2: mechanisms for re-sending a message, requesting data that hasn't got through etc.

* A client interface to request map data from the whole network, so we can get a global picture. Currently, each peer can only show you its neighbours.

* Probably should be renamed to NetLife or P2PLife.

* more documentation... yes, I know!

* And lots more!

Join the fun

There is a server running at www.zaygo.com:4331 with space for 8 connections. If this gets filled up, I'll try it with 15 connections (4x4). The module includes weblife-client.pl and weblife-server.pl scripts, so just:

# perl WebLife/weblife-client.pl -a my.address.com -p www.zaygo.com:4331

and we'll see what happens.

Update: yeah, not literally my.address.com. You have to replace that with your actual web address.

Your comments welcome, especially if you know anything about the science behind this sort of stuff. If there's enough interest, I'll chuck it up on sourceforge or CPAN.

## files separated by #==

#== weblife-client.pl ################
#!/usr/bin/perl -w

use WebLife::System qw(set_debug);
use strict;

set_debug(debug => ['WebLife::Game::run']);
my %args = @ARGV;
my $addr = shift @ARGV;
$args{'-p'} && $args{'-a'}
        or die "Usage: $0 -p pos.server.address:port -a " .
            "address[:port]";

my $sys = WebLife::System->new (
        pos_server_addr    => $args{'-p'},
        address            => $args{'-a'}
            );
$sys->run;
exit 0;

#== weblife-server.pl ####################
#!/usr/bin/perl -w

use WebLife::System qw(set_debug);
use strict;
set_debug(debug => ['WebLife::Game::run']);

my %args = @ARGV;
$args{'-a'} &&
        $args{'-m'} &&
        $args{'-u'} 
        or die "Usage: $0 -a address:port  -m mapsize" .
            " -u universe size";

my $sys = WebLife::System->new (
        is_pos_server    => 1,
        map_size        => $args{'-m'},
        universe_size    => $args{'-u'},
        address            => $args{'-a'},
            );
$sys->run;
exit 0;
#== WebLife/System.pm ################

package WebLife::System;

=head1 WebLife::System

Package to run a Game of Life over a P2P network of hosts. Each host i
+s
responsible for a square of n x n cells. Every n turns, each host 
communicates its current state with its neighbours. It then calculates
n further turns of the game, starting with a larger map of it and all 
its neighbours, and stripping off one layer of cells each turn in orde
+r
to arrive at its new state. 

Example (n=3):

Step 1: neighbours send me their state

    -xx --x ---
    --- --- ---
    --- --- ---

    --- --x ---
    --x -x- ---
    --x x-- ---

    --- --x -xx
    --- --- -xx
    --- --- ---

Step 2: create larger map

    -xx--x---
    ---------
    ---------
    -----x---
    --x-x----
    --xx-----
    -----x-xx
    -------xx
    ---------

Step 3: calculate 3 turns

turn 1 (U = state unknown, cells discarded from map)

    UUUUUUUUU
    U-------U
    U-------U
    U-------U
    U-x-x---U
    U-xxx---U
    U-----xxU
    U----xxxU
    UUUUUUUUU

turn 2

    UUUUUUU
    U-----U
    U-----U
    Ux-x--U
    Ux-xx-U
    U-x---U
    UUUUUUU

turn 3

    UUUUU
    U---U
    U-xxU
    U-xxU
    UUUUU

Step 4: Send my new state to my neighbours

    \  |  /
      ---
    - -xx -
      -xx
    /  |  \

    
The system is not completely peer-to-peer. Initial positions,
neighbour addresses and initial cell maps are provided by a 
position server. (It is possible to devise algorithms which
allow peers to self-organize into a square, but this is rather complex
+!)

The universe as a whole is also a square of m x m peers. The position
server determines the choice of m and n, and can therefore decide how
big the Game of Life will be.
    
=head2 Synopsis

    # join an existing game:
    my $sys = WebLife::System->new(
            address            => 'my.website.net',
            pos_server_addr    => 'pos.serveraddress.net:4331' 
                );
    $sys->run;

    # create your own game:
    my $sys = WebLife::System->new(
            is_pos_server    => 1,
            map_size        => 10,
            universe_size    => 5,
            address            => 'my.website.net'
                );
    $sys->run;

=cut

use strict;
use vars qw($SYSTEM @EXPORT_OK);
use Exporter;
use Carp qw(carp confess);
use base qw(Exporter);
BEGIN {@EXPORT_OK = qw($SYSTEM debug set_debug);}
use WebLife::AddressBook;
use WebLife::MessageHandler;
use WebLife::Universe;
use WebLife::Parser;
use WebLife::Game;
use WebLife::Transport;
use WebLife::PositionServer;
use WebLife::Preparer;

my $PORT = 4331;

=head2 Methods

=over 4

=item new

    WebLife::System->new(%options);

    WebLife::System->new(
            address         => 'address[:port]',
            pos_server_addr    => 'address:port',
                );

    WebLife::System->new(
            is_pos_server     => 1,
            map_size        => $map_size,
            universe_size    => $univ_size,
            address            => 'address[:port]',
                );

Creates a new WebLife::System object.

Options:

=over 8

=item address

Internet address where the peer will run, with or without a port numbe
+r.
If no port number is given, the default will be used (currently 4331).
If this option isn't given, the address will be 'localhost' - not much
use except for testing. 

=item pos_server_addr

Internet address, including port, of the peer which will act as positi
+on
server for this peer. The position server will also tell you about you
+r
initial map, your position, the size of your universe and map, and you
+r
neighbour addresses and positions.

=item is_pos_server

Flag to tell the object to be a position server. The default is 0. If
this is not set, then the pos_server_addr must be given.

=item map_size

Integer size of the area of the Game of Life board which will be the 
responsibility of a single peer. E.g. if map_size is 10, each peer wil
+l
be responsible for a 10x10 square containing 100 cells. This option
is only meaningful if the is_pos_server flag is set.

=item universe_size

Integer size of the WebLife universe. E.g. if universe_size is 10, 
the universe will be a 10x10 square requiring 100 peers. This option
is only meaningful if the is_pos_server flag is set.

Total number of cells in the universe = (universe_size ** 2) * (map_si
+ze ** 2)

=back

=cut

sub new {
    return $SYSTEM if defined $SYSTEM;
    my $class = shift;
    
    my $self = bless {@_}, $class;
    $SYSTEM = $self;
    $self->{addressbook}     ||= new WebLife::AddressBook;
    $self->{messagehandler} ||= new WebLife::MessageHandler;
    $self->{parser}         ||= new WebLife::Parser;
    $self->{preparer}        ||= new WebLife::Preparer;
    $self->{address}         ||= 'localhost'; # change to die, later
    
    my $port;
    if ($self->{address} =~ /:(\d+)$/) {
        $port = $1;
    } else {
        $port = $PORT;
        $self->{address} .= ":$port"; 
    }
    $self->{transport}         ||= new WebLife::Transport($port);
    
    if ($self->{is_pos_server}) {
        die "No map_size defined" unless $self->{map_size};
        die "No universe_size defined" unless $self->{universe_size};
        $self->{universe}         ||= new WebLife::Universe($self->{un
+iverse_size});
        $self->{pos_server_obj} ||= new WebLife::PositionServer(
                map_size => $self->{map_size}
                    );
    } 
    else {
        die "No pos_server_addr defined" unless $self->{pos_server_add
+r};
    }
    
    return $self;
}

############## POSITION FUNCTIONS ################
=item is_pos_server

    $sys->is_pos_server
    
Returns true if the WebLife::System object is a position server. 

=cut

sub is_pos_server {
    return (+shift)->{is_pos_server};
}

=item pos_server_addr

    $sys->pos_server_addr

Returns the address of the system's position server. Dies with an erro
+r
if the system is a position server itself.

=cut

sub pos_server_addr {
    my $self = shift;
    
    die "I am pos server" if $self->{is_pos_server};
    
    return $self->{pos_server_addr};
}

=item run

    $sys->run

Starts the system running. A running system will begin by asking for
info from the position server, or by waiting for peers to join the
network if it is a position server itself. Once it has the necessary 
info, it will start calculating its section of the game of life board 
and exchanging its board map regularly with neighbours.

=cut

sub run {
    my $self = shift;
    
    while (1) {
        $self->_mainloop;
    }
}

sub send {
    my $self = shift;
    my ($msg, $addr) = @_;
    
    my $string = $self->{parser}->serialize($msg);
    $self->{transport}->send($string, $addr);
}

sub _mainloop {
    my $self = shift;
    # receive messages
    my @msg_strs = $self->{transport}->receive;
    foreach my $str (@msg_strs) {
        my $msg = $self->{parser}->parse($str);
        $self->{messagehandler}->handle($msg);
    }
    
    if ($self->{is_pos_server}) {
        debug "running position server";
        $self->{pos_server_obj}->run;
    }
    
    if ($self->{preparer}->is_ready) {
        debug "updating neighbours";
        $self->_update_nbrs; # this first, otherwise we may skip updat
+ing!
        debug "running game";
        $self->{game}->run;
    }
    else {
        debug "getting ready";
        $self->{preparer}->get_ready;
    }
}

sub _update_nbrs {
    my $self = shift;
    
    my @nbrs = $self->universe->neighbours($self->{position});
    my $t = $self->{game}->time;
    my $msg;
    my $map = $self->{game}->my_current_map;
    my $size = $map->size;
    my $mapstr = $map->as_string;
    
    die "No size!" unless $size;
    foreach my $pos (@nbrs) {
        next if $self->{updated_nbrs}{$pos}[$t];
        my $content = join "\n", 
                "Time: $t",
                "Pos: $self->{position}", 
                "Map: $mapstr",
                "Map-size: $size";
        $msg ||= new WebLife::Message (
                content => $content,
                params    => {type => 'map'}
                    )->from_me;
        my $addr = $self->addressbook->find_addr($pos);
        debug "Updating $pos at $addr for time $t ";
        $self->send($msg, $addr) and 
                    $self->{updated_nbrs}{$pos}[$t]++;
    }
}

sub delete {
    my $self = shift;
    
    warn "Deleting WebLife::System object";
    $SYSTEM = undef;
    $self = undef;
}

##################### SET METHODS ###################

=item set_pos
    
    $sys->set_pos($pos);
    $sys->set_pos('1.2');

Sets the system's position. Positions are strings in the format 
'row.column'. Row and column start at 0.

=cut

sub set_pos {
    my $self = shift;
    my $pos = shift;
    
    if ($self->{position}) {
        warn "Got position $self->{position} already, not setting";
        return;
    }
    
    debug "Setting my position to $pos";
    $self->{position} = $pos;
    $self->addressbook->add($self->address, $pos);
}

=item set_game

    $sys->set_game($game);

Sets the system's WebLife::Game object.

=cut

sub set_game {
    my $self = shift;
    
    if ($self->{game}) {
        warn "Got game already, ignoring";
        return;
    }
    
    $self->{game} = shift;
}

=item set_universe

    $sys->set_universe($univ);

Sets the system's universe object.

=cut

sub set_universe {
    my $self = shift;
    
    if ($self->{universe}) {
        warn "Got universe already, ignoring";
        return;
    }
    
    $self->{universe} = shift;
}

############## ACCESSORS ################

=item game

    my $game = $sys->game;

Retrieves the system's WebLife::Game object.

=item universe

    my $univ = $sys->universe;

Retrieves the system's WebLife::Universe object.

=item position

    my $pos = $sys->position;

Retrieves the system's current position.

=item address

    my $addr = $sys->address;

Retrieves the system's current internet address, including port.

=item messagehandler

    my $mh = $sys->messagehandler;

Retrieves the system's WebLife::MessageHandler object.

=item pos_server

    my $ps = $sys->pos_server;

Retrieves the system's WebLife::PositionServer object. Returns undef i
+f
the system is not a position server.


=item addressbook

    my $mh = $sys->addressbook;

Retrieves the system's WebLife::AddressBook object.

=item parser

    my $mh = $sys->parser;

Retrieves the system's WebLife::Parser object.

=back

=cut

{ # privacy
for my $subname (qw(game universe addressbook messagehandler address p
+osition)){
    no strict 'refs';
    *{"WebLife::System::$subname"} = sub {
        my $self = shift;
        return $self->{$subname};
    };    
}
} # privacy

sub pos_server {
    my $self = shift;
    
    return $self->{pos_server_obj};
}

{
my (%debug, %info, %pos);

sub debug {
    my $msg = shift;
    my @flags = @_;
    push @flags, @{[caller(1)]}[0, 3]; # package, subroutine

    return unless grep {$debug{$_}} @flags;    
    if (scalar keys %pos) {
        return unless $pos{$SYSTEM->position};
    }
    my @preamble;
    my $div = '-' x 50;
    push @preamble, "Address: " .$SYSTEM->address if $info{address};
    push @preamble, "Sub: " . @{[caller(1)]}[3] if $info{sub};
    push @preamble, "Pos: " . $SYSTEM->position if $info{pos};
    $msg = "\n" . join ("\n", $div, @preamble, $msg, $div);
#    if ($level == 1) {
#        confess $msg;
#    } else {
        print STDERR $msg;
#    }
}

sub set_debug {
    my %opts = @_;
    
    $opts{pos} ||= [];
    $opts{debug} ||= [];
    $opts{info} ||= [];
    @pos{ @{$opts{pos}} } = (1) x scalar @{$opts{pos}};
    @debug{ @{$opts{debug}} } = (1) x scalar @{$opts{debug}};
    @info{ @{$opts{info}} } = (1) x scalar @{$opts{info}};
}
}

=head2 See also

L<WebLife>

=cut

1;

#== WebLife/PositionServer.pm ################

package WebLife::PositionServer;

use WebLife::System qw/$SYSTEM debug/;
use strict;

sub new {
    my $class = shift;
    
    my $self = bless {@_}, $class;
    my $it = $SYSTEM->universe->iterator;
    while (my $pos = $it->()) {
        my $map = WebLife::Game::Map->random($self->{map_size});
        $self->{maps}{$pos} = $map;
    }
    
    return $self;
}


sub new_position {
    my $self = shift;
    
    # return a position if one is available
    $self->{iterator} ||= $SYSTEM->universe->iterator;
    
    return $self->{iterator}->();        
}

sub accept_peer {
    my $self = shift;
    my $addr = shift;
    
    my $pos = $self->new_position();
    unless ($pos) {
        my $msg = new WebLife::Message (
                content => 'FULL',
                params    => {type => 'initial_info'} 
                    )->from_me;
        $SYSTEM->send($msg, $addr);
    }
    else {
        $SYSTEM->addressbook->add($addr, $pos);
    }
}

sub run {
    my $self = shift;
    
    my $it = $SYSTEM->universe->iterator;
    my @addrs;
    while (my $pos = $it->()) {
        next if defined $SYSTEM->position and $pos eq $SYSTEM->positio
+n;
        my $addr = $SYSTEM->addressbook->find_addr($pos);
        return unless defined $addr; # not full yet!
        push @addrs, $addr;
    }
    
    foreach my $addr (@addrs) {
        $self->{sent_initial_info}{$addr} ||= $self->_send_initial_inf
+o($addr);
    }
}

sub _send_initial_info {
    my $self = shift;
    my ($addr) = @_;

    my $pos = $SYSTEM->addressbook->find_pos($addr);
    my @nbrs = $SYSTEM->universe->neighbours($pos);
    
    my $content;
    foreach my $np (@nbrs) {
        my $addr = $SYSTEM->addressbook->find_addr($np);
        $content .= "Nbr: $np-$addr\n";
    }
    $content .= join "\n",
            "Map: " . $self->get_map($pos)->as_string,
            "Pos: $pos",
            "Universe-size: " . $SYSTEM->universe->size,
            "Map-size: " . $self->{map_size}
                ;
    my $msg = new WebLife::Message (
            content    => $content,
            params    => {type => 'initial_info'}
                )->from_me;
    
    $SYSTEM->send($msg, $addr);
}

sub get_map {
    my $self = shift;
    my $pos = shift;
    
    return $self->{maps}{$pos};
}

1;

#== WebLife/Preparer.pm ################

package WebLife::Preparer;

use WebLife::System qw/$SYSTEM debug/;
use WebLife::Message;
use strict;
use vars qw($POLITENESS);

$POLITENESS = 60;

sub new {
    my $class = shift;
    
    bless {@_}, $class;
}

sub is_ready {
    my $self = shift;
    
    return 0 unless defined $SYSTEM->position;
    debug "got position";
    return 0 unless defined $SYSTEM->universe;
    debug "got universe";
    return 0 unless defined $SYSTEM->game;
    debug "got game";
    return  0 unless $self->_got_nbrs;
    debug "got neighbours";
    return 1;
}

sub get_ready {
    my $self = shift;
    
    if (not defined $SYSTEM->position) {
        $self->_find_pos;
    } 
    if (not defined $SYSTEM->game) {
        $self->_find_game;
    }
}

sub _find_pos {
    my $self = shift;
    
    $self->{asked_pos} ||= 0; # warnings
    return if time - $self->{asked_pos} < $POLITENESS;
    if ($SYSTEM->is_pos_server) {
        my $pos = $SYSTEM->pos_server->new_position;
        $SYSTEM->set_pos($pos);
    }
    else {
        my $msg = new WebLife::Message (
                params     => {type => 'whereami'},
                content    => ''
                    )->from_me;
        if ($SYSTEM->send($msg, $SYSTEM->pos_server_addr)) {
            $self->{asked_pos} = time;
        }
    }
}

sub _find_game {
    my $self = shift;
    
    return unless defined $SYSTEM->position;
    if ($SYSTEM->is_pos_server) {
        my $map = $SYSTEM->pos_server->get_map($SYSTEM->position);
        my $game = new WebLife::Game(
                map => $map
                    );
        $SYSTEM->set_game($game)
    }
}

sub _got_nbrs {
    my $self = shift;
    
    defined $SYSTEM->position or die "Can't look for neighbours withou
+t position";
    defined $SYSTEM->universe or die "Can't look for neighbours withou
+t universe";
    
    my @nbrs = $SYSTEM->universe->neighbours($SYSTEM->position);
    debug "Neighbours: " . join " ", @nbrs;
    foreach (@nbrs){
        unless ($SYSTEM->addressbook->find_addr($_)) {
            debug "Can't find address for pos $_";
            return 0;
        }
    }
    
    debug "got neighbours";
    return 1;
}

1;

#== WebLife/Game.pm ################

package WebLife::Game;

use WebLife::System qw($SYSTEM debug);
use WebLife::Game::Map;


sub new { 
    # requires map => $map
    my $class = shift;
    
    my $self = {@_};
    die "Game requires a map" unless $self->{map};
    $self->{time} = 0;
    
    bless $self, $class;
}

sub run {
    my $self = shift;
    
#    debug "running game";
    if (defined $SYSTEM->position and $self->{map}) {
        $self->{maps}->[0]{$SYSTEM->position} = delete $self->{map};
    }
    
    return unless $self->_ready_to_update;
    my $bigmap = $self->_build_temp_map;
    debug "Neighbour map at $self->{time}:\n" . $bigmap->dump;
    my $newmap = $self->_run_map($bigmap);
    $self->{time}++;
#    debug "Updating map:\n" . $newmap->dump;
    $self->_save_my_new_map($newmap);
}

sub time {
    my $self = shift;
    
    return $self->{time};
}

sub add_map {
    my $self = shift;
    my ($pos, $time, $map, $mapsize) = @_;
    
    $map = WebLife::Game::Map->from_string($map, $mapsize) unless ref 
+$map;
    $self->_save($map, $pos, $time);
}

sub my_current_map {
    my $self = shift;
    
    return $self->{maps}[$self->{time}]{$SYSTEM->position} || $self->{
+map};
}

sub _build_temp_map {
    my $self = shift;
    
    my @nine = $SYSTEM->universe->unnormalized_nine_square($SYSTEM->po
+sition);
    my @mydims = split /\./, $SYSTEM->position;
    my $bigmap;
    my $small_map_size;
    foreach my $pos (@nine) {
        my $npos = $SYSTEM->universe->normalize($pos);
        my $m = $self->{maps}[$self->{time}]{$npos};
        $small_map_size ||= $m->size; #shd always be the same
        $bigmap ||=  new WebLife::Game::Map($small_map_size * 3);
#        debug "adding in map for $npos\n" . $m->dump;
            
        my @dims = split /\./, $pos;
        @dims = map {$dims[$_] - $mydims[$_]+1}(0 .. 1); #relativize
        # top left shd be 0,0
        foreach my $sq ($m->squares) {
            my $val = $m->value($sq);
            $sq->[0] += $dims[0] * $small_map_size;
            $sq->[1] += $dims[1] * $small_map_size;
            $bigmap->set_value($sq, $val);
        }
    }
    
    debug "Built temporary map:\n" . $bigmap->dump;    
    return $bigmap;
}

sub _run_map {
    my $self = shift;
    my $map = shift;
    
    debug "Neighbour map at time $self->{time}:\n" . $map->dump;
    my $turns = $map->size / 3;
    for (1 .. $turns) {
        $map = $self->_run_map_once($map);
    }
    debug "New map for time $self->{time} + 1:\n" . $map->dump;
    
    return $map;
}

sub _run_map_once {
    my $self = shift;
    my $map = shift;

    
    my $newmap = new WebLife::Game::Map($map->size - 2);
    foreach my $sq ($map->squares) {
        my @nbrsq = $map->nbrs($sq);
        next if @nbrsq < 8; # edge
        
        my $total;
        my $newsq;
        $newsq->[0] = $sq->[0] - 1;
        $newsq->[1] = $sq->[1] - 1;
        map {
            my $value = $map->value($_) || 0;
            $total+= $value;
        }@nbrsq;
        if ($total < 2 or $total > 3) {
            $newmap->set_value($newsq, 0);
        }
        elsif ($total == 3) {
            $newmap->set_value($newsq, 1);
        }
        else {
            $newmap->set_value($newsq, $map->value($sq));
        }
    }
    
    debug "new map\n" . $newmap->dump;
    return $newmap;
}

sub _save_my_new_map {
    my $self = shift;
    
    $self->{maps}[$self->{time}]{$SYSTEM->position} = shift;
}

sub _save {
    my $self = shift;
    my ($map, $pos, $time) = @_;
    
    debug "Saving map\n" . $map->dump . "\nfor pos $pos at time $time"
+;
    $self->{maps}[$time]{$pos} = $map;
}

sub _ready_to_update {
    my $self = shift;
    
    return 0 unless $SYSTEM->position;
    my @nbrs = $SYSTEM->universe->neighbours($SYSTEM->position);
    my $n = 0;
    my $s = 1;
    my @miss;
#    debug "nbrs are: " . join "\t", @nbrs;
    foreach my $pos (@nbrs) {
        unless (defined $self->{maps}->[$self->{time}]->{$pos}){
            $s = 0;
            push @miss, $pos;
        }
        else {
            $n++;
        }
    }
    
    debug "Got $n nbr maps for time $self->{time}: success $s: missing
+" . join " ", @miss;
    return $s;
}


1;

#== WebLife/Transport.pm ################

package WebLife::Transport;

use IO::Socket;
use IO::Select;
use WebLife::System qw(debug $SYSTEM);
use strict;
use vars qw($WRITE_TIMEOUT $READ_TIMEOUT);
$WRITE_TIMEOUT = 90;
$READ_TIMEOUT = 1;

=pod

parent--->sends messages. Timeout
  |
  |
forwards messages "as and when", with a very quick timeout
so that child never waits for parent
  ^
  |
  |
child<---gets messages. No need to wait for sending!

=cut

sub new {
    my $class = shift;
    
    my $self = {port => shift};
    bless $self, $class;
    
    my $pid = open RECEIVER, "-|";
    defined $pid or die "Can't fork receiver: $!";
    if (! $pid) { # in child
        $self->_receiver_run; # never returns
    }
    else { # in parent
        $self->{read_fh} = \*RECEIVER;
        $self->{receiver_pid} = $pid;
        
        return $self;
    }
}

sub send {
    my $self = shift;
    my $string = shift;
    my $addr = shift;
    
    debug "No address!" unless $addr;
    
    my $socket = new IO::Socket::INET (
            PeerAddr     => $addr,
            Timeout        => $WRITE_TIMEOUT,
                ) or die "Couldn't create socket to $addr: $@";
    my $sent = $socket->send($string);
    $socket->shutdown(2);
    
    debug "Sent $sent chars of message:\n$string\nto $addr";
    return $sent;
}

sub receive {
    my $self = shift;
    
    my $line;
    local $@;
    local $SIG{ALRM} = sub {die "WebLife timeout";};
    eval {
        alarm 1;
        $line = readline($self->{read_fh});
    };
    alarm 0;
    if ($@ =~ /WebLife timeout/) {
        return ();
    }
    elsif ($@) {
        die $@;
    }
    
    debug "first line of msg: $line";
    die "Bad read from child: $line" unless $line =~ /MSG\s(\d+)/;
    my $ln = $1;
    my $msg;
    read $self->{read_fh}, $msg, $ln;
    debug "Read message:\n$msg\nfrom child";
    
    return ($msg);
}

sub DESTROY {
    my $self = shift;
    
    kill 'QUIT' => $self->{receiver_pid} if $self->{receiver_pid};
    my $fh = $self->{read_fh};
    close $fh if $fh;
}
############## CHILD METHODS ###################

sub _receiver_run { # child only
    # child writes to STDOUT
    my $self = shift;

    $|=1;
    $self->{queue} = [];    
    $self->{socket} = new IO::Socket::INET(
            Listen         => 1, 
            LocalPort     => $self->{port},
                ) or die $!;
    $self->{select} = new IO::Select ($self->{socket});
    
    while (1) {
        $self->_get_msgs;
        $self->_pass_msgs;
    }
}

sub _get_msgs {
    my $self = shift;
    
    my @msgs;
    my $sel = $self->{select};
    my $lsn = $self->{socket};
    local $SIG{PIPE} = 'IGNORE';
    
    while (my @readable = $sel->can_read($READ_TIMEOUT)) {
        last unless @readable;
        foreach my $sock (@readable) {
            if ($sock == $lsn) {
                my $rdr = $lsn->accept;
                $sel->add($rdr);
            }
            else {
                my $str;
                while (my $l = $sock->getline) {
                    $str .= $l;
                }
                $sel->remove($sock);
                $sock->close;
                debug "Child received message:\n$str";
                push @msgs, $str;
            }
        }
    }

    push @{$self->{queue}}, @msgs;
}

sub _pass_msgs {
    my $self = shift;
    
    my $msg = shift @{$self->{queue}};
    return unless $msg;
    local $@;
    local $SIG{ALRM} = sub {die "WebLife timeout";};
    eval {
        alarm 1;
        syswrite STDOUT, "MSG " . length ($msg) . "\n$msg";
    };
    alarm 0;
    if ($@ and $@ =~ /WebLife timeout/) {
        unshift @{$self->{queue}}, $msg; # try again
    }
    elsif ($@) {
        die $@;
    }
    else {
        debug "Printed message:\n$msg\nto parent";
    }
    
    return;
}

1;

#== WebLife/AddressBook.pm ################

package WebLife::AddressBook;

sub new {
    my $class = shift;
    
    bless {@_}, $class;
}



sub remove {
    my $self = shift;
    my $addr = shift;
    
    delete $self->{$addr};
}

sub add {
    my $self = shift;
    my ($addr, $pos) = @_;
    
    $self->{$addr} = $pos;
}

sub find_addr {
    my $self = shift;
    my $pos = shift;
    
    my ($addr) = grep {$self->{$_} eq $pos} keys %$self;
    return $addr;
}

sub find_pos {
    my $self = shift;
    
    my $addr = shift;
    return $self->{$addr};
}

1;

#== WebLife/Message.pm ################

package WebLife::Message;

use strict;
use WebLife::System qw($SYSTEM);

sub new {
    my $class = shift;
    
    bless {@_}, $class;
}

sub params {
    my $self = shift;
    
    return keys %{$self->{params}};
}

sub from_me {
    my $self = shift;
    
    $self->{params}{from} = $SYSTEM->address;
    
    return $self;
}

sub param {
    my $self = shift;
    
    return $self->{params}{+shift};
}

sub content {
    my $self = shift;
    
    return $self->{content};
}

1;

#== WebLife/MessageHandler.pm ################

package WebLife::MessageHandler;

=head1 WebLife::MessageHandler

Class to handle messages for the WebLife module.

=cut

use strict;
use WebLife::System qw($SYSTEM debug);
use WebLife::Game;
use WebLife::Game::Map;
use WebLife::Universe;
use Carp qw(confess);
use vars qw(%TABLE);

%TABLE = (
    whereami     => '_handle_pos_request',
#    pos            => '_handle_peer_pos',         # obsolete? use lat
+er for peer migration
    map            => '_handle_peer_map',
    initial_info=> '_handle_initial_info',
);

=head2 Methods

=over 4

=item new

    new WebLife::MessageHandler->new(%options);

Creates a new MessageHandler object. No options are currently used.

=cut


sub new {
    my $class = shift;
    
    bless {@_}, $class;
}

=item handle

    $mh->handle($msg);

Handles a WebLife::Message object and performs the appropriate action.

=back

=cut

sub handle {
    my $self = shift;
    my $msg = shift;
    
    my $method = $TABLE{$msg->param('type')};
    $self->$method($msg);
}

sub _handle_pos_request {
    my $self = shift;
    my $msg = shift;
    
    my $peeraddr = $msg->param('from');
    
    if ($SYSTEM->is_pos_server) {
        $SYSTEM->pos_server->accept_peer($peeraddr);
    }
    else {
        $self->_forward($msg, $SYSTEM->pos_server_addr)
    }
}

sub _handle_initial_info {
    my $self = shift;
    my $msg = shift;
    
    my $from = $msg->param('from');
    unless ($from eq $SYSTEM->pos_server_addr) {
        warn "Got initial info, but not from position server address: 
+ignoring";
        return;
    }
    if ($msg->content eq 'FULL') {
        die "Position server has no spare positions";
    }
    my ($mapstr, $mapsize);
    my @lines = split /\n/, $msg->content;
    foreach (@lines) {
        /^([^:]+):\s*(.*)/;
        if ($1 eq 'Nbr') {
            my ($pos, $addr) = split /-/, $2;
            debug "Adding nbr pos $pos at $addr";
            $SYSTEM->addressbook->add($addr, $pos);
        }
        elsif ($1 eq 'Map') {
            $mapstr = $2;
        }
        elsif ($1 eq 'Pos') {
            debug "Setting pos to $2";
            $SYSTEM->set_pos($2);
        }
        elsif ($1 eq 'Universe-size') {
            my $univ = WebLife::Universe->new($2);
            $SYSTEM->set_universe($univ);
        }
        elsif ($1 eq 'Map-size') {
            $mapsize = $2;
        }
    }
    my $map = WebLife::Game::Map->from_string($mapstr, $mapsize);
    $SYSTEM->set_game(
             WebLife::Game->new(map => $map)
                );
    if ($self->{map_msg_queue}) {
        foreach my $msg (@{ $self->{map_msg_queue} }) {
            $self->_handle_peer_map($msg);
        }
    }
}

# sub _handle_peer_pos {
#     my $self = shift;
#     my $msg = shift;
# 
#     my @lines = split /\n/, $msg->content;
#     foreach (@lines) {
#         /(.*?)\s*-\s*(.*)/;
#         $SYSTEM->addressbook->add($1,$2);
#     }
# }

sub _handle_peer_map {
    my $self = shift;
    my $msg = shift;
    
    my @lines = split /\n/, $msg->content;
    my ($pos, $time, $mapstr, $size);
    foreach my $ln (@lines) {
        $ln =~ /([^:]*):\s*(.*)/;
        $1 eq 'Pos' and $pos = $2;
        $1 eq 'Time' and $time = $2;
        $1 eq 'Map' and $mapstr = $2;
        $1 eq 'Map-size' and $size = $2;
    }
    
    debug "Parsed message as:\npos $pos\ntime $time\nmap string $mapst
+r\nsize $size";
    
    # HACK!
    if (defined $SYSTEM->game) {
        $SYSTEM->game->add_map($pos, $time, $mapstr, $size);
    }
    else {
        push @{$self->{map_msg_queue}}, $msg;
    }
    
}

sub _forward {
    my $self = shift;
    my ($msg, $addr) = @_;
    
    $SYSTEM->send($msg, $addr);
}

=head2 See also

L<WebLife>, L<WebLife::Messsage>

=cut

1;

#== WebLife/Parser.pm ################

package WebLife::Parser;

use WebLife::Message;
use WebLife::System qw(debug);

sub new {
    my $class = shift;
    
    bless {@_}, $class;
}

sub parse {
    my $self = shift;
    my $string = shift;
    
    my %env;
    while ($string =~ s/(.*?)\n//s) {
        length $1 or last; # two newlines end envelope
        $_ = $1;
        /(.*?):\s*(.*)\s*/ or die "Faulty message";
        $env{params}{$1} = $2;
    }
    $env{content} = $string;
    return WebLife::Message->new(%env);
}

sub serialize {
    my $self = shift;
    my $message = shift;
    
    my $string;
    foreach my $param ($message->params) {
        $string .= "$param: " . $message->param($param) . "\n";
    }
    $string .= "\n";
    $string .= $message->content;
    
    return $string;
}

1;

#== WebLife/Test.pm ################

# WARNING: this is probably out of date apart from test_all();
# usage:
perl -MWebLife::Test -e 'test_all()';

package WebLife::Test;

use strict;
use Exporter;
use Data::Dumper qw(Dumper);
use Carp;
use base 'Exporter';
use vars qw/@EXPORT $TTY/;
@EXPORT = qw(
    test_universe
    test_game
    test_transport
    test_parser
    test_pos_server
    test_addressbook
    test_messagehandler
    test_all
    test
);
use WebLife::System qw($SYSTEM set_debug);

# BEGIN {*CORE::GLOBAL::die = \&Carp::confess;}
set_debug(
        debug     => [
#            'WebLife::Game::_ready_to_update',
#            'WebLife::System::_update_nbrs',
#            'WebLife::System::_mainloop',
#            'WebLife::Game::_build_temp_map',
#            'WebLife::Game::_run_map_once',
#            'WebLife::Game::_run_map',
             'WebLife::Game::run',
#            'WebLife::Game::Map::as_string',
#            'WebLife::Game::Map::from_string',
#            'WebLife::MessageHandler::handle_initial_info',
#            'WebLife::MessageHandler::handle_peer_map',
#            'WebLife::System::set_pos',
#            'WebLife::Preparer::is_ready',
#            'WebLife::Preparer::_got_nbrs',
#            'WebLife::Transport::receive',
#            'WebLife::Transport::send',
#            'WebLife::Transport::_pass_msgs',
#            'WebLife::Transport::_get_msgs',
#            'WebLife::Transport::new',
        ],
        info     => [
            'sub',
            'address',
            'pos',
        ],
        pos        => [
            '1.1', 
#            '1.0'
        ],
            );

sub test {
    foreach (@_){
        eval "test_$_()";
        die $@ if $@;
    }
    
}

sub test_game {
    require WebLife::Game;
    
    my $size = 5;
    my $map = new WebLife::Game::Map ($size * 3);
    foreach ($map->squares) {
        $map->set_value($_, int rand 2);
    }
    
    print "Testing update of map\n";
    print "Initial map\n";
    print $map->dump;
    my $g = new WebLife::Game(
            size     => $size, 
            map     => $map,
                );
    my $newmap = $g->_run_map($map);
    print "Map after $size turns\n";
    print $newmap->dump;
    
    print "Testing single turn of game\n";
    my $s = new WebLife::System;
}

sub test_universe {
    require WebLife::Universe;
    
    my $u = new WebLife::Universe (10);
    my @p = qw(11.11 0.0 0.11 5.5 5.11 -1.-1 -1.-11);
    for (@p) {
        print "prenormalize: $_\t";
        print "normalized:" . $u->normalize($_) . "\n";
    }
    
    for (qw(5.5 10.10)) {
        print "position $_\n";
        map {print "\tneighbour $_\n"} $u->neighbours($_);
    }
    
    my $it = $u->iterator;
    print "iterator\n";
    while (my $pos = $it->()) {
        print "$pos\n";
    }
}

sub test_transport {
    require WebLife::Transport;
    
    my $port = 54331;
    unless (my $chld = fork()) {
        print "Listening\n";

        my $lsnr = new WebLife::Transport($port);
        my %check;
        while (1) {
            my @msgs = $lsnr->receive;
            foreach (@msgs) {
                /msg (\d+) of (\d+)/ and
                $check{$2}{$1}++;
                print "Got all messages from stress test of $2\n" if s
+calar keys %{$check{$2}} == $2;
            }
        }
    }
    else {
        sleep 2;
        my $sndport = $port;
        for my $stress(1 .. 4) {
            $stress *= 5;
            print "\n\nStress testing with $stress connections\n";
            for (1 .. $stress) {
                my $sndr =  new WebLife::Transport(++$sndport);
                $sndr->send("msg $_ of $stress", "localhost:$port");
            }
            sleep $stress;
        }
        kill 'QUIT' => $chld;
    }
}

sub test_parser {
    require WebLife::Parser;
    require WebLife::Message;
    
    my $p = new WebLife::Parser;
    
    my $type = 'greeting';
    my $from = 'me';
    my $cont = "hello\n\n\twelcome from: Zanzibar\n";
    print "Serializing message of type $type from $from, content $cont
+\n";
    my $m = new WebLife::Message (
            content => $cont,
            params     => {type => $type, from => $from},
                );
    print "==RESULT==\n";
    my $str = $p->serialize($m);
    print "$str\n====\n";
    my $back = $p->parse($str);
    print "Parsing result\n";
    print Dumper $back;
}

sub test_pos_server {
    require WebLife::System;
    require WebLife::PositionServer;
    
    my $s = new WebLife::System (
            is_pos_server    => 1,
            map_size        => 3,
            universe_size    => 3,
                );
    
    while (my $pos = $s->pos_server->new_position) {
        print "Position server served pos $pos\n";
    }
}

sub test_addressbook {
    require WebLife::AddressBook;
    
    my $a = new WebLife::AddressBook;
    my @addr = qw(
            127.0.0.1:4321 
            123.23.231.1:4321
            33.44.11.22:4321
            211.21.0.7:4321
                );
    my @pos = qw(1.1 1.2 2.1 2.2);
    for (0 .. $#pos) {
        $a->add($addr[$_], $pos[$_]);
    }
    my $seen;
    for (0 ..1) {
        foreach (@pos) {
            print "Addr for pos $_: " . $a->find_addr($_);
            print "\n";
        }
        foreach (@addr) {
            print "Pos for addr $_: " . $a->find_pos($_);
            print "\n";
        }
        print "Now removing addrs\n" unless $seen++;
        foreach (@addr){
            $a->remove($_);
        }
    }
}

sub test_messagehandler {
    require WebLife::System;
    require WebLife::Message;
    require WebLife::MessageHandler;
    
    my $other = '127.2.3.1:4321';
    my $s = new WebLife::System(
            map_size         => 3, 
            is_pos_server     => 1, 
            universe_size     => 3,
                );
    
    print "Handling whereami message with pos_server\n";
    my $m = new WebLife::Message(
            content => '',
            params    => {
                type     => 'whereami',
                from    => $other,
            }
                );
    $s->messagehandler->handle($m);
    $s->delete; # redefine $SYSTEM
    
    $s = new WebLife::System(pos_server_addr => $other);
    print "Handling 'FULL' initial_info message\n";
    my $m = new WebLife::Message(
            content => 'FULL',
            params    => {
                type     => 'initial_info',
                from    => $other,
            }
                );
    eval {
        $s->messagehandler->handle($m);
    };
    print $@? "Died: $@\n" : "Didn't die!\n";
    
    print "Handling initial_info message\n";
    my $info = join ("\n", 
            "Nbr: 1.1-foo.bar.com:4321",
            "Nbr: 1.2-bar.bat.com:4321",
            "Nbr: 2.2-blah.net:4321",
            "Map: 010010010"
                );
    print "Message:\n=====\n$info\n=====\n";
    $m = new WebLife::Message (
            content => $info,
            params     => {type => 'initial_info', from => $other}
                );
    $s->messagehandler->handle($m);
    print "My map is now:\n" . $s->game->my_current_map->dump . "\n";
    print "My address book:\n" . Dumper ($s->addressbook) . "\n";
    
    print "Handling map message\n";
    my $mapstr = $s->game->my_current_map->as_string;
    $mapstr = $s->addressbook->find_pos($other) . "\n0\n$mapstr";
    $m = new WebLife::Message(
            content    => $mapstr,
            params    => {
                type     => 'map',
                from    => $other
            }
                );
    $s->messagehandler->handle($m);
    print "Map for node at $other is:\n";
    print $s->game->{maps}->[0]{$s->addressbook->find_pos($other)}->du
+mp;
    print "(Cheating by looking inside game hashref)\n";
    print "Should be same as my own map:\n";
    print $s->game->my_current_map->dump;
    
}

sub test_all {
    require WebLife::System;
    
    my $map_size = 10;
    my $univ_size = 7;
    my $svrs = $univ_size ** 2;
    my $port = 4331;
    my @kids;
    for my $i (1 .. $svrs-1) {
        $TTY = $i+1;
        if (my $kid = fork) {
            $DB::inhibit_exit = 0;
            push @kids, $kid;
        }
        else {
            # in child
            
            sleep 5; # time for the parent to start
            my $myport = $port + $i;
            my $s = new WebLife::System(
                    pos_server_addr     => "localhost:$port",
                    address                => "localhost:$myport",
                        );
            $s->run;
        }
    }
    
    my $svr = new WebLife::System(
                    map_size        => $map_size,
                    is_pos_server     => 1,
                    universe_size    => $univ_size,
                        );
    *WebLife::System::DESTROY = sub {
            warn "Killing children";
            map {kill 'QUIT' => $_} @kids;
                };
    $svr->run;
}


package DB;

sub get_fork_TTY {
    my $tty = "/dev/pts/$WebLife::Test::TTY";
    warn "Forking tty to $tty";
    $DB::fork_TTY = $tty;
    return $tty;
}


1;

#== WebLife/Transport.pm.nonforking ################

# The old version. Works fine, so you can use this if you want,
# but probably breaks earlier under stress


package WebLife::Transport;

use IO::Socket;
use IO::Select;
use WebLife::System qw(debug $SYSTEM);
use strict;
use vars qw($WRITE_TIMEOUT $READ_TIMEOUT);
$WRITE_TIMEOUT = 15;
$READ_TIMEOUT = 1;

sub new {
    my $class = shift;
    
    bless {port => shift}, $class;
}

sub send {
    my $self = shift;
    my $string = shift;
    my $addr = shift;
    
    debug "No address!" unless $addr;
    my $socket = new IO::Socket::INET (
            PeerAddr => $addr,
                ) or die "Couldn't create socket to $addr: $@";
    $socket->timeout($WRITE_TIMEOUT);
    $socket->send($string);
    $socket->shutdown(2);
    
    debug "Sent message:\n$string\nto $addr", 'send';
    return 1;
}

sub receive {
    my $self = shift;
    
    my $port = $self->{port};
    local $SIG{PIPE} = 'IGNORE';
    my @msgs;
    $self->{socket} ||= new IO::Socket::INET(
            Listen         => 1, 
            LocalPort     => $port,
                );
    my $lsn = $self->{socket};
    $self->{select} ||= new IO::Select ($lsn);
    my $sel = $self->{select};
    
    while (my @readable = $sel->can_read($READ_TIMEOUT)) {
        last unless @readable;
        foreach my $sock (@readable) {
            if ($sock == $lsn) {
                my $rdr = $lsn->accept;
                $sel->add($rdr);
            }
            else {
                my $str;
                while (my $l = $sock->getline) {
                    $str .= $l;
                }
                $sel->remove($sock);
                $sock->close;
                debug "received message:\n$str", 'receive';
                push @msgs, $str;
            }
        }
    }
    
    return @msgs;
}

1;

#== WebLife/Universe.pm ################

package WebLife::Universe;

use strict;
use WebLife::System qw(debug);

sub new {
    my $class = shift;
    
    my $self = {max_dims => shift};
    
    bless $self, $class;
}

sub size {
    my $self = shift;
    
    return $self->{max_dims};
}

sub neighbours {
    my $self = shift;
    my $pos = shift;
    
    $pos = $self->normalize($pos);
    my @pos = $self->unnormalized_nine_square($pos);
    
    my @norm;
    foreach (@pos) {
        push @norm, $self->normalize($_);
    }
    
    my %seen; # necessary for universe with size 2!
    return grep {$_ ne $pos and not $seen{$_}++} @norm;
}

sub unnormalized_nine_square {
    my $self = shift;
    my $pos = shift;
    
    $pos = $self->normalize($pos);
    
    # find all positions next to $pos
    my ($x, $y) = split /\./, $pos;
    my @pos = map {
        my $cx = $_;
        map {"$cx.$_"} ($y-1 .. $y+1)
    } ($x-1 .. $x+1);
    
    return @pos;
}

sub normalize {
    my $self = shift;
    my $pos = shift;
    
    my ($x, $y) = split /\./, $pos;
    my $max = $self->{max_dims};
    while ($x < 0) {$x+= $max;}
    while ($y < 0) {$y+= $max;}
    while ($x >= $max) {$x -= $max;}
    while ($y >= $max) {$y -= $max;}

    return "$x.$y";    
}

sub _max_dims {
    my $self = shift;
    
    return ($self->{max_dims}) x 2;
}

sub iterator {
    my $self = shift;
    
    my $pos = '0.-1';
    my ($max_x, $max_y)= $self->_max_dims;
    my $it = sub {
        my @dims = split /\./, $pos;

        if (++$dims[1] >= $max_y) {
            $dims[0]++;
            $dims[1] = 0;
        }
        if ($dims[0] >= $max_x) {
            return undef;
        }
        
        $pos = "$dims[0].$dims[1]";
        return $pos;
    };
    
    return $it;
}

1;

#== WebLife/Game/Map.pm ################


package WebLife::Game::Map;

use WebLife::System qw(debug $SYSTEM);
use Data::Dumper qw(Dumper);
use Carp qw(confess);
use strict;
use vars qw($SPARSITY);

$SPARSITY = 5;

sub new {
    my $class = shift;
    
    confess "No size at " . $SYSTEM->position unless $_[0];
    bless {size => shift}, $class;
}

sub random {
    my $class = shift;
    
    my $self = $class->new(@_);
    foreach ($self->squares) {
        my $val = (int rand $SPARSITY)? 0:1;
        $self->set_value($_, $val);
    }
    
    return $self;
}

sub from_string {
    my $class = shift;
    my ($str, $size) = @_;
    
    debug "Parsing map string $str";
    my $self = $class->new($size);
    foreach my $pos (split /,/, $str) {
        my ($x, $y) = split /:/, $pos; 
        $self->set_value([$x, $y], 1);
    }
    
    local $Data::Dumper::Deepcopy = 1;
    debug "Created map object:\n" . Dumper ($self);
    return $self;
}


sub as_string {
    my $self = shift;
    
    local $Data::Dumper::Deepcopy = 1;
    debug "Serializing map object:\n" . Dumper ($self);
    my @ones;
    foreach my $sq (grep {$self->value($_)} $self->squares) {
        push @ones, "$sq->[0]:$sq->[1]";
    }
    
    debug "Created map string " . join ",", @ones;
    return join ",", @ones;
}


sub dump {
    my $self = shift;
    
    my @dim = (1 .. $self->{size});
    my $dump = "\n";
    for my $x (@dim) {
        for my $y (@dim) {
            $dump .= $self->value([$x, $y])? 'x' : '.';
        }
        $dump .= "\n";
    }
    $dump .= "\n";
    
    return $dump;
}

sub size {
    my $self = shift;
    
    return $self->{size};
}

sub set_value {
    my $self = shift;
    my $sq = shift;
    my $val = shift;
    
    $self->{squares}->[$sq->[0]]->[$sq->[1]] = $val;
}

sub nbrs {
    my $self = shift;
    my $sq = shift;
    
    my ($x, $y) = @$sq;
    my @nbrs = map {
        my $cx = $_;
        map {[$cx, $_]} ($y-1 .. $y+1)
    } ($x-1 .. $x+1);
    @nbrs = grep {
        $_->[0] >= 1 and $_->[0] <= $self->{size} and
        $_->[1] >= 1 and $_->[1] <= $self->{size} and
        ($_->[0] != $x or $_->[1] != $y)
    } @nbrs;
}

sub squares {
    my $self = shift;
    
    my $size = $self->{size};
    my @sq = map {
        my $x = $_;
        map {[$x, $_]} (1 .. $size)
    } (1 .. $size);
    
    return @sq;
}

sub value {
    my $self = shift;
    my $sq = shift;
    
    return $self->{squares}->[$sq->[0]]->[$sq->[1]];
}

1;

[zentara]

I'll give you a comment. :-) It's a nice example of how to run a peer-to-peer networked application. You don't really expect people to all go out and run it do you? The real winner is you, because now you understand all these concepts (better than me for sure).Congratulations. If you want people to play, switch to "online gambling games". :-) You might end up with a job in the Carribean.

[dash2]

my mind agrees but my vanity is hurt ... :-)

andramoiennepemousapolutropon

[jepri]

Did you know that all packages in a file that gets loaded, are also loaded? You should be able to distribute it as just one file. I'm slightly embarresed to admit that I'm too lazy to chop your code into 15 pieces in order to run it. I tried to take the use statements out but I must have hit something else as well.

I know how horrible I sound, but I regularily install a couple of large programs every day, as well as lots of smaller scripts. I've developed an allergic reaction to programs with complicated install instructions.

Having said all that, yes, very few people bother to visit the code section. Expect to receive about 1/4 of the XP you would get for posting in Meditations.

____________________
Jeremy
I didn't believe in evil until I dated it.

[dash2]

There's a .tar.gz file available - see the top of the comment.

andramoiennepemousapolutropon

[dash2]

Wow, that's a bit depressing. I spent a lot of time on this, but I get no comments and nobody to try this out.

I guess if I read the code section more often myself, I would have more reason to complain.

Server running again at www.zaygo.com:4331. I killed the previous one as nobody had joined in 8 hours. You may have to be patient, as you won't see anything until everyone joins the game. Alternatively you could do

set_debug(debug => ['WebLife::Transport::receive', WebLife::Game::run'
+]);

in the server-client.pl if you want to see how messages work.

andramoiennepemousapolutropon

[elwarren]

I think this is very cool.

I read the CUFP section almost everyday, it's my favorite part of the site. I would have expected to find this in there.

I'm going to give this a try tonight if your server is still up (and after I read the code, been waiting to see somebody do something in perl2perl)

[dash2]

Thanks. I think the problem is getting enough people to test it all at once. Nothing can happen until 8 nodes are connected, so probably people come along and try it, then give up when they get bored. The problem is that then the system is still expecting to be able to talk to them.

So you might want to start a couple of nodes on different ports, or indeed different PCs. You can always set up your whole system on one pc via the loopback but that provides a serious bottleneck.

Server still waiting.

andramoiennepemousapolutropon