AI-Evolve-Befunge

 view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Critter.pm  view on Meta::CPAN

=cut

sub move {
    my ($self, $board) = @_;
    my $rv;
    local $@ = '';
    eval {
        $rv = $self->invoke($board);
    };
    if($@ ne '') {
        debug("eval error $@\n");
        $rv = Result->new(name => $self->blueprint->name, died => 1);
        my $reason = $@;
        chomp $reason;
        $rv->fate($reason);
    }
    $rv->tokens($self->tokens);
    return $rv;
}

lib/AI/Evolve/Befunge/Critter/Result.pm  view on Meta::CPAN

}

=head1 NAME

    AI::Evolve::Befunge::Critter::Result - results object


=head1 DESCRIPTION

This object stores the fate of a critter.  It stores whether it died
or lived, what the error message was (if it died), whether it won, and
if it was playing a board game, whether it choose a move.  It also
stores some statistical information about how many moves it made, and
stuff like that.


=head1 CONSTRUCTOR

=head2 new

    Result->new();

lib/AI/Evolve/Befunge/Critter/Result.pm  view on Meta::CPAN

Indicates the choice of positions to play (for board game physics
engines).

=item died

Integer value, true if the critter died.

=item fate

String value, indicates the error message returned by eval, to
indicate the reason for a critter's death.

=item name

Name of the critter, according to its blueprint.

=item score

Integer value supplied by the Physics engine, indicates how well it
thought the critter did.

lib/AI/Evolve/Befunge/Migrator.pm  view on Meta::CPAN

    my $select = IO::Select->new($$self{loc});
    $select->add($$self{sock}) if defined $$self{sock};
    my @sockets = $select->can_read(2);
    foreach my $socket (@sockets) {
        if($socket == $$self{loc}) {
            my $rv = $socket->sysread($$self{txbuf}, 4096, length($$self{txbuf}));
            $$self{dead} = 1 unless $rv;
        } else {
            my $rv = $socket->sysread($$self{rxbuf}, 4096, length($$self{rxbuf}));
            if(!defined($rv) || $rv < 0) {
                debug("Migrator: closing socket due to read error: $!\n");
                undef $$self{sock};
                next;
            }
            if(!$rv) {
                debug("Migrator: closing socket due to EOF\n");
                undef $$self{sock};
            }
        }
    }
}

lib/AI/Evolve/Befunge/Migrator.pm  view on Meta::CPAN

    my $select = IO::Select->new();
    $select->add($$self{loc}) if length $$self{rxbuf};
    $select->add($$self{sock})  if(length $$self{txbuf} && defined($$self{sock}));
    my @sockets = $select->can_write(0);
    foreach my $socket (@sockets) {
        if($socket == $$self{loc}) {
            my $rv = $socket->syswrite($$self{rxbuf}, length($$self{rxbuf}));
            if($rv > 0) {
                substr($$self{rxbuf}, 0, $rv, '');
            }
            debug("Migrator: write on loc socket reported error $!\n") if($rv < 0);
        }
        if($socket == $$self{sock}) {
            my $rv = $socket->syswrite($$self{txbuf}, length($$self{txbuf}));
            if(!defined($rv)) {
                debug("Migrator: closing socket due to undefined syswrite retval\n");
                undef $$self{sock};
                next;
            }
            if($rv > 0) {
                substr($$self{txbuf}, 0, $rv, '');
            }
            if($rv < 0) {
                debug("Migrator: closing socket due to write error $!\n");
                undef $$self{sock};
            }
        }
    }
}


=head2 spin_exceptions

    $migrator->spin_exceptions();

t/02physics.t  view on Meta::CPAN

dies_ok(sub { $test->run_board_game() }, "no board");
dies_ok(sub { $test->run_board_game([], $board) }, "no critters");
dies_ok(sub { $test->run_board_game([$cpart1], $board) }, "too few critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1, $cplay1], $board ) }, "too many critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1], $board, $cplay1 ) }, "too many args");
lives_ok(sub{ $test->run_board_game([$cpart1, $cplay1], $board ) }, "a proper game was played");
$$test{passable} = 0;
push_debug(1);
stdout_like(sub{ $test->run_board_game([$cdier1, $cplay1], $board ) },
     qr/STDIN \(-4,-4\): infinite loop/,
     "killed with an infinite loop error");
pop_debug();
lives_ok(sub{ $test->run_board_game([$ctier1, $ctier2], $board) }, "a proper game was played");
lives_ok(sub{ $test->run_board_game([$cpart1, $cpart1], $board) }, "a tie game was played");
push_quiet(0);
stdout_is(sub { $test->run_board_game([$cplay1, $cpart1], $board) }, <<EOF, "outputs board");
   01
 0 o.
 1 ..
EOF
pop_quiet();

t/10migration.t  view on Meta::CPAN

        my @sockets = $select->can_read(10);
#        print(STDERR "select() returned " . scalar(@sockets) . "\n");
        foreach my $socket (@sockets) {
#            print(STDERR "read event from socket " . $socket->fileno() . "\n");
            exit(0) if $socket == $sock2;
            if($socket == $listener) {
#                print(STDERR "new connection\n");
                my $new = $socket->accept();
                $new->blocking(1);
                $new->print(<<EOF);
parse error
[I12345 D3 F31 Htest2\]abcdefgh
[I12346 D3 F30 Htest2\]abcdefgi
[I12347 D3 F29 Htest2\]abcdefgj
[I12348 D3 F28 Htest2\]abcdefgk
[I12349 D3 F27 Htest2\]abcdefgl
[I12350 D3 F26 Htest2\]abcdefgm
EOF
                $select->add($new);
            } else {
                my $data;