view release on metacpan or  search on metacpan

t/01-server.t  view on Meta::CPAN

use constant WORKER_TIME => 5;

use_ok ('REST::Depend::Regex::Gearman');


my @urls      : shared = ();         # workers report back here
my @labels    : shared = ();        # workers report task labels here
my $work_cnt  : shared = 0;
my $work_drop : shared = 0;
my $alives    : shared = 0;



sub run_experiment {
    my $deps = shift;
    my $d = REST::Depend::Regex::Gearman->new ($deps);
    my %o = @_;
    $o{worker} ||= 'perfect';

    @urls = ();
    @labels = ();
    $work_cnt = 0;
    $work_drop = 0;

    warn "== MAIN: $o{nr_workers} =====================================================================================";
    my @workers = map { threads->new(\&Worker::run, "W$_", $o{worker}) } (1.. $o{nr_workers});
    map { $_->detach } @workers;
    $alives = scalar @workers;

    $d->evolve ($o{kick});

    my $start_time = time;
    my $end_time   = $start_time + $o{max_time}; # we plan to work at most some secs on that
    my @gearmandized;

  LOOP: {
    do {
      RESPONSE:

t/01-server.t  view on Meta::CPAN

	    if (my ($place) = $d->things ($url)) {
		next RESPONSE unless $place;                               # it can happen that we get reported a very old worker result
#		warn "MAIN: already got a place at $url: ".Dumper $place;
		$place->touch;
	    } else {
		warn "MAIN: STRANGE got $url in queue which is not known in Petri";
		next RESPONSE;
	    }
	    $d->evolve ($url);
	}
	warn "MAIN: sleeping a bit with alive $alives";
	sleep 1;

#	$d->evolve ('xxx') if time > $end_time - $loop_time + 2; # 2 secs after start we pretend something else happened

	@gearmandized = grep { $_->{gearmandized}->[0] } map { $d->things ($_) } $d->transitions;
	warn "still gearmandized: " . scalar @gearmandized;

#	warn "MAIN: now is ".time;
	my @lates = grep { $_->{gearmandized}->[1] + $_->{gearmandized}->[2] < time }   @gearmandized;
	warn "MAIN: lates are now ".Dumper [ map { $_->{label} } @lates ];