view release on metacpan or  search on metacpan

t/utils.pl  view on Meta::CPAN

use Event qw(one_event loop unloop);
use Cluster::Init::DB;
use Cluster::Init::Process;
use Time::HiRes qw(time);

our $cltab="t/cltab";
`cp t/cltab.master $cltab`;

sub lines
{
  $DB::single=1;
  open(F,"<t/out") || die $!;
  my @F=<F>;
  my $lines=$#F + 1;
  return $lines;
}

sub lastline
{
  open(F,"<t/out") || die $!;
  my @F=<F>;
  chomp(my $lastline=$F[$#F]);
  return $lastline;
}

sub step
{
  my $steps=shift;
  for(1..$steps)
  {
    one_event(0);
  }
}

sub run
{
  my $seconds=shift;
  Event->timer(at=>time() + $seconds,cb=>sub{unloop()});
  loop();
}

my $slowdown=1;
sub go
{
  my ($dfa,$state,$timeout)=@_;
  $timeout||=1;
  $timeout*=$slowdown;
  my $debug = $ENV{DEBUG} || 0;
  my $start=time();
  my $stop=$start+$timeout;
  until($dfa->state eq $state)
  {
    # warn "state=".$dfa->state."\n" if $debug > 1;
    step(1);
    if (time > $stop)
    {
      # my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
      my $subline = (caller(0))[2];
      warn "timeout after $timeout secs: $subline wanted $state got ".$dfa->state;
      last;
    }
  }
  # warn "state=".$dfa->state."\n" if $debug > 1;
  if ($dfa->state eq $state)
  {
    # try to adjust for slow CPUs, debug performance, etc.
    my $stop=time();
    my $elapsed=$stop-$start;
    $slowdown*=($elapsed/($timeout*.5)) if $elapsed > ($timeout/2);
    # warn "slowdown $slowdown\n";
    return 1;
  }

  return 0;
}

sub tags
{
  my $db=shift;
  my @cktag = sort @_;
  # warn $db;
  my @all=$db->allclass("Cluster::Init::Process");
  my @tag = sort map {$_->{tag}} @all;
  # warn "@tag";
  return 0 unless @cktag==@tag;
  for(my $i=0;$i<@tag;$i++)
  {
    return 0 unless $tag[$i] eq $cktag[$i];
  }
  return 1;
}

sub waitdown
{
  while(1)
  {
    my $count = `ps -eaf 2>/dev/null | grep perl | grep $0 | grep -v defunct | grep -v runtests | grep -v grep | wc -l`;
    chomp($count);