AI-Evolve-Befunge
view release on metacpan or search on metacpan
lib/AI/Evolve/Befunge/Migrator.pm view on Meta::CPAN
domain socket) used to pass critters to and from the parent process.
Note that you probably don't want to call this directly... in most
cases you should call spawn_migrator, see below.
=cut
sub new {
my ($package, %args) = @_;
croak("The 'Local' parameter is required!") unless exists $args{Local};
my $host = global_config('migrationd_host', 'quack.glines.org');
my $port = global_config('migrationd_port', 29522);
my $self = {
host => $host,
port => $port,
dead => 0,
loc => $args{Local},
rxbuf => '',
txbuf => '',
lastc => 0,
};
return bless($self, $package);
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
use Carp;
use IO::Socket;
use Language::Befunge::Vector;
use Perl6::Export::Attrs;
use Socket qw(AF_UNIX SOCK_STREAM PF_UNSPEC);
use YAML qw(LoadFile Load Dump);
use aliased 'AI::Evolve::Befunge::Util::Config' => 'Config';
$ENV{HOST} = global_config("hostname", `hostname`);
$ENV{HOST} = "unknown-host-$$-" . int rand 65536 unless defined $ENV{HOST};
chomp $ENV{HOST};
my @quiet = 0;
my @verbose = 0;
my @debug = 0;
=head1 NAME
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
printf("\n");
}
}
=head2 setup_configs
setup_configs();
Load the config files from disk, set up the various data structures
to allow fetching global and overrideable configs. This is called
internally by L</global_config> and L</custom_config>, so you never
have to call it directly.
=cut
my $loaded_config_before = 0;
my @all_configs = {};
my $global_config;
sub setup_configs {
return if $loaded_config_before;
my %global_config;
my @config_files = (
"/etc/ai-evolve-befunge.conf",
$ENV{HOME}."/.ai-evolve-befunge",
);
push(@config_files, $ENV{AIEVOLVEBEFUNGE}) if exists $ENV{AIEVOLVEBEFUNGE};
foreach my $config_file (@config_files) {
next unless -r $config_file;
push(@all_configs, LoadFile($config_file));
}
foreach my $config (@all_configs) {
my %skiplist = (byhost => 1, bygen => 1, byphysics => 1);
foreach my $keyword (keys %$config) {
next if exists $skiplist{$keyword};
$global_config{$keyword} = $$config{$keyword};
}
}
$global_config = Config->new({hash => \%global_config});
$loaded_config_before = 1;
}
=head2 global_config
my $value = global_config('name');
my $value = global_config('name', 'default');
my @list = global_config('name', 'default');
my @list = global_config('name', ['default1', 'default2']);
Fetch some config from the config file. This queries the global
config database - it will not take local overrides (for host,
generation, or physics plugin) into account. For more specific
(and flexible) config, see L</custom_config>, below.
=cut
sub global_config :Export(:DEFAULT) {
setup_configs();
return $global_config->config(@_);
}
=head2 custom_config
my $config = custom_config(host => $host, physics => $physics, gen => $gen);
my $value = $config('name');
my $value = $config('name', 'default');
my @list = $config('name', 'default');
my @list = $config('name', ['default1', 'default2']);
Generate a config object from the config file. This queries the
global config database, but allows for overrides by various criteria -
it allows you to specify overridden values for particular generations
(if the current generation is greater than or equal to the ones in the
config file, with inheritance), for particular physics engines, and
for particular hostnames.
This is more specific than L</global_config> can be. This is the
interface you should be using in almost all cases.
If you don't specify a particular attribute, overrides by that
attribute will not show up in the resulting config. This is so you
can (for instance) specify a host-specific override for the physics
engine, and query that successfully before knowing which physics
engine you will be using.
Note that you can recurse these, but if you have two paths to the same
value, you should not rely on which one takes precedence. In other
lib/AI/Evolve/Befunge/Util/Config.pm view on Meta::CPAN
=head2 custom_config
This module does not actually implement the constructor - please see
custom_config() in L<AI::Evolve::Befunge::Util> for the details.
=head1 METHODS
=head2 config
my $value = global_config('name');
my $value = global_config('name', 'default');
my @list = global_config('name', 'default');
my @list = global_config('name', ['default1', 'default2']);
Fetch some data from the config object.
=cut
sub config {
my ($self, $keyword, $value) = @_;
$value = $$self{hash}{$keyword}
if exists $$self{hash}{$keyword};
t/01config.t view on Meta::CPAN
my $num_tests;
BEGIN { $num_tests = 0; };
use Test::More;
use Test::Output;
use Test::Exception;
use AI::Evolve::Befunge::Util;
# global_config
is(scalar global_config('basic_value', 'undefined'), 42, 'config(exists)');
is(scalar global_config('nonexistent', 'undefined'), 'undefined', 'config(!exists)');
is_deeply([global_config('nonexistent', 'undefined')], ['undefined'], 'wantarray config(!exists)');
is_deeply([global_config('nonexistent', undef)], [undef], 'wantarray config(!exists)');
is_deeply([global_config('nonexistent')], [], 'wantarray config(!exists)');
is_deeply([global_config('test_list')], [5,8,13], 'wantarray config(array exists)');
is_deeply([global_config('basic_value')], [42], 'wantarray returns value even if no default given');
BEGIN { $num_tests += 7 };
my $global = custom_config();
my $proper = custom_config(host => 'myhost', physics => 'foo', gen => 6);
my $wrong1 = custom_config(host => 'myhost', physics => 'bar', gen => 8);
my $wrong2 = custom_config(host => 'nohost', physics => 'bar', gen => 2);
is($global->config('basic_value' ), 42, 'global value inherited');
is($proper->config('basic_value' ), 42, 'global value inherited');
is($wrong1->config('basic_value' ), 42, 'global value inherited');
is($wrong2->config('basic_value' ), 42, 'global value inherited');
is($global->config('overrode' ), 0, '$global overrode');
is($proper->config('overrode' ), 5, '$proper overrode');
is($wrong1->config('overrode' ), 1, '$wrong1 overrode');
is($wrong2->config('overrode' ), 0, '$wrong2 overrode');
is($global->config('overrode_host' ), 0, '$global overrode_host');
is($proper->config('overrode_host' ), 1, '$proper overrode_host');
is($wrong1->config('overrode_host' ), 1, '$wrong1 overrode_host');
is($wrong2->config('overrode_host' ), 0, '$wrong2 overrode_host');
is($global->config('overrode_host_physics' ), 0, '$global overrode_host_physics');
is($proper->config('overrode_host_physics' ), 6, '$proper overrode_host_physics');
is($wrong1->config('overrode_host_physics' ), 0, '$wrong1 overrode_host_physics');
is($wrong2->config('overrode_host_physics' ), 0, '$wrong2 overrode_host_physics');
is($global->config('overrode_host_physics_foo' ), 0, '$global overrode_host_physics_foo');
is($proper->config('overrode_host_physics_foo' ), 1, '$proper overrode_host_physics_foo');
is($wrong1->config('overrode_host_physics_foo' ), 0, '$wrong1 overrode_host_physics_foo');
is($wrong2->config('overrode_host_physics_foo' ), 0, '$wrong2 overrode_host_physics_foo');
is($global->config('overrode_host_physics_baz' ), 0, '$global overrode_host_physics_bar');
is($proper->config('overrode_host_physics_baz' ), 0, '$proper overrode_host_physics_bar');
is($wrong1->config('overrode_host_physics_baz' ), 0, '$wrong1 overrode_host_physics_bar');
is($wrong2->config('overrode_host_physics_baz' ), 0, '$wrong2 overrode_host_physics_bar');
is($global->config('overrode_host_physics_gen' ), 0, '$global overrode_host_physics_gen');
is($proper->config('overrode_host_physics_gen' ), 1, '$proper overrode_host_physics_gen');
is($wrong1->config('overrode_host_physics_gen' ), 0, '$wrong1 overrode_host_physics_gen');
is($wrong2->config('overrode_host_physics_gen' ), 0, '$wrong2 overrode_host_physics_gen');
is($global->config('overrode_host_physics_gen_2'), 0, '$global overrode_host_physics_gen_2');
is($proper->config('overrode_host_physics_gen_2'), 1, '$proper overrode_host_physics_gen_2');
is($wrong1->config('overrode_host_physics_gen_2'), 0, '$wrong1 overrode_host_physics_gen_2');
is($wrong2->config('overrode_host_physics_gen_2'), 0, '$wrong2 overrode_host_physics_gen_2');
is($global->config('overrode_host_physics_gen_5'), 0, '$global overrode_host_physics_gen_5');
is($proper->config('overrode_host_physics_gen_5'), 1, '$proper overrode_host_physics_gen_5');
is($wrong1->config('overrode_host_physics_gen_5'), 0, '$wrong1 overrode_host_physics_gen_5');
is($wrong2->config('overrode_host_physics_gen_5'), 0, '$wrong2 overrode_host_physics_gen_5');
is($global->config('overrode_host_physics_gen_6'), 0, '$global overrode_host_physics_gen_6');
is($proper->config('overrode_host_physics_gen_6'), 1, '$proper overrode_host_physics_gen_6');
is($wrong1->config('overrode_host_physics_gen_6'), 0, '$wrong1 overrode_host_physics_gen_6');
is($wrong2->config('overrode_host_physics_gen_6'), 0, '$wrong2 overrode_host_physics_gen_6');
is($global->config('overrode_host_physics_gen_8'), 0, '$global overrode_host_physics_gen_8');
is($proper->config('overrode_host_physics_gen_8'), 0, '$proper overrode_host_physics_gen_8');
is($wrong1->config('overrode_host_physics_gen_8'), 0, '$wrong1 overrode_host_physics_gen_8');
is($wrong2->config('overrode_host_physics_gen_8'), 0, '$wrong2 overrode_host_physics_gen_8');
BEGIN { $num_tests += 44 };
BEGIN { plan tests => $num_tests };
0 1 2 3 4 5 6 7 8 9 a b
1 c d e f 10 11 12 13 14 15 16
2 17 18 19 1a 0 0 0 0 0 0 0
EOF
dies_ok(sub { code_print }, "no code");
dies_ok(sub { code_print("") }, "no sizex");
dies_ok(sub { code_print("", 1) }, "no sizey");
BEGIN { $num_tests += 5 };
# note: custom_config and global_config are thoroughally tested by 01config.t.
BEGIN { plan tests => $num_tests };
t/09population.t view on Meta::CPAN
is($testdata, $gooddata, 'savefile contents match up');
undef $goodfile;
undef $testfile;
}
chdir($olddir);
BEGIN { $num_tests += 5 };
# config
$population->generation(999);
is($population->config->config('basic_value'), 42, 'global config works');
$population->generation(1000);
is($population->config->config('basic_value'), 67, 'config overrides work');
BEGIN { $num_tests += 2 };
# breed
seed(map { oneish, 0.3, 0, 0.7, oneish, 0.5, 0.2, 0.1, 0.1, oneish, 0.4, 0, 0, 0, 0, 0 } (1..1000));
$population->breed();
@population = @{$population->blueprints};
my %accepted_sizes = (1 => 1, 256 => 1, 625 => 1, 1296 => 1);
( run in 0.643 second using v1.01-cache-2.11-cpan-49f99fa48dc )