AI-Evolve-Befunge

 view release on metacpan or  search on metacpan

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

    $migrator->spin_reads();

Handle read-related events.  This method will delay for up to 2
seconds if no reading is necessary.

=cut

sub spin_reads {
    my $self = shift;
    $self->try_connect() unless defined $$self{sock};
    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;

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

    $migrator->spin_writes();

Handle write-related events.  This method will not block.

=cut

sub spin_writes {
    my $self = shift;
    $self->try_connect() unless defined $$self{sock};
    return unless length($$self{txbuf} . $$self{rxbuf});
    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}));

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

=head2 spin_exceptions

    $migrator->spin_exceptions();

Handle exception-related events.  This method will not block.

=cut

sub spin_exceptions {
    my $self = shift;
    my $select = IO::Select->new();
    $select->add($$self{loc});
    $select->add($$self{sock}) if defined($$self{sock});
    my @sockets = $select->has_exception(0);
    foreach my $socket (@sockets) {
        if($socket == $$self{loc}) {
            debug("Migrator: dying: select exception on loc socket\n");
            $$self{dead} = 1;
        }
        if($socket == $$self{sock}) {
            debug("Migrator: closing socket due to select exception\n");
            undef $$self{sock};
        }
    }
}


=head2 alive

    exit unless $migrator->alive();

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

a total of (Popsize*1.5) critters in the array at once.  If the number
of incoming migrations exceeds that, the remainder will be left in the
Migrator receive queue to be handled the next time around.

=cut

sub migrate_import {
    my ($self) = @_;
    my $critter_limit = ($self->popsize * 1.5);
    my @new;
    my $select = IO::Select->new($$self{migrate});
    if($select->can_read(0)) {
        my $data;
        $$self{migrate}->blocking(0);
        $$self{migrate}->sysread($data, 10000);
        my $in;
        while(((scalar @{$self->blueprints} + scalar @new) < $critter_limit)
           && (($in = index($data, "\n")) > -1)) {
            my $line = substr($data, 0, $in+1, '');
            debug("migrate: importing critter\n");
            my $individual =
                AI::Evolve::Befunge::Blueprint->new_from_string($line);

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

    }
    return $rv;
}


=head2 pair

    my ($c1, $c2) = $population->pair(map { 1 } (@population));
    my ($c1, $c2) = $population->pair(map { $_->fitness } (@population));

Randomly select and return two blueprints from the blueprints array.
Some care is taken to ensure that the two blueprints returned are not
actually two copies of the same blueprint.

The @fitness parameter is used to weight the selection process.  There
must be one number passed per entry in the blueprints array.  If you
pass a list of 1's, you will get an equal probability.  If you pass
the critter's fitness scores, the more fit critters have a higher
chance of selection.

=cut

sub pair {
    my $self = shift;
    my @population = @{$self->blueprints};
    my $popsize    = scalar @population;
    my $matchwheel = Algorithm::Evolutionary::Wheel->new(@_);
    my $c1 = $matchwheel->spin();
    my $c2 = $matchwheel->spin();

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

        return $port;
    }

    for my $fd (0..sysconf(_SC_OPEN_MAX)-1) {
        next if $fd == $listener->fileno();
        next if $fd == $sock2->fileno();
        next if $fd == STDERR->fileno();
        POSIX::close($fd);
    }
    $sock2->blocking(1);
    my $select = IO::Select->new($listener, $sock2);
    while(1) {
#        print(STDERR "sitting in select()\n");
        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;
                my $rv = $socket->sysread($data, 4096);
                if($rv < 1) {
                    $select->remove($socket);
                } else {
#                    print(STDERR "got data [$data]\n");
                    $sock2->print($data);
                }
            }
        }
    }
}

tools/migrationd  view on Meta::CPAN

    Listen    => 1,
    LocalHost => $host,
    LocalPort => $port,
    ReuseAddr => 1,
);

nonquiet("Listening on $host:$port.\n");

die("Could not create socket: $!\n") unless defined $listener;

my $select = IO::Select->new($listener);

while(1) {
    my @handles = $select->can_read(1);
    foreach my $handle (@handles) {
        if($handle == $listener) {
            my $new = $listener->accept();
            $new->blocking(0);
            $select->add($new);
            if($debug) {
                my ($port, $ip) = sockaddr_in($new->peername);
                $ip = inet_ntoa($ip);
                debug("New connection from $ip:$port\n");
            }
        } else {
            my $data = '';
            $handle->recv($data, 100000, 0);
            if(length($data)) {
                $data =~ s/\r/\n/g; # turn CRs into LFs
                $data =~ s/\n\n/\n/g; # remove redundant LFs
                my $linesize;
                while(($linesize = index($data, "\n")) > -1) {
                    my $line = substr($data, 0, $linesize+1, '');
                    if($debug) {
                        my ($port, $ip) = sockaddr_in($handle->peername);
                        $ip = inet_ntoa($ip);
                        debug("line from $ip:$port: $line");
                    }
                    foreach my $recipient ($select->handles) {
                        next if $recipient == $listener;
                        next if $recipient == $handle;
                        $recipient->send($line, 0);
                    }
                }
            } else {
                if($debug) {
                    my ($port, $ip) = sockaddr_in($handle->peername);
                    $ip = inet_ntoa($ip);
                    debug("closing connection from $ip:$port due to EOF\n");
                }
                $select->remove($handle);
            }
        }
    }
    @handles = $select->has_exception(0);
    foreach my $handle (@handles) {
        die("exception on listener socket\n") if $handle == $listener;
        if($debug) {
            my ($port, $ip) = sockaddr_in($handle->peername);
            $ip = inet_ntoa($ip);
            debug("closing connection from $ip:$port due to exception\n");
        }
        $select->remove($handle);
    }
}