## 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 is
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 order
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 number.
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 position
server for this peer. The position server will also tell you about your
initial map, your position, the size of your universe and map, and your
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 will
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_size ** 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->{universe_size});
		$self->{pos_server_obj} ||= new WebLife::PositionServer(
				map_size => $self->{map_size}
					);
	} 
	else {
		die "No pos_server_addr defined" unless $self->{pos_server_addr};
	}
	
	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 error
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 updating!
		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 if
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 position)){
	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->position;
		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_info($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 without position";
	defined $SYSTEM->universe or die "Can't look for neighbours without 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->position);
	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 later 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 $mapstr\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 scalar 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)}->dump;
	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;