Cluster-Init

 view release on metacpan or  search on metacpan

lib/Cluster/Init/Daemon.pm  view on Meta::CPAN

sub haltall
{
  my $self=shift;
  my $data=shift;
  for my $group (keys %{$self->{groups}})
  {
    debug "halting $group";
    $self->{groups}{$group}->halt;
  }
  $data->{msg}="all groups halting";
  $self->timer(HALTTIME,{at=>time+5},$data);
  return (HALTED,$data);
}

sub putres
{
  my $self=shift;
  my $data=shift;
  debug dump $data;
  my $ldt = $self->ldt;
  my $client = $self->client;

lib/Cluster/Init/Group.pm  view on Meta::CPAN

  affirm { defined($level) };
  my (@proc) = $db->get('Cluster::Init::Process', {group=>$group});
  for my $proc (@proc)
  {
    next if $proc->haslevel($level);
    next if $proc->configured;
    next if $proc->{kickme};
    my $tag = $proc->{tag};
    debug "stopping $tag level $level";
    # slap a kickme sign on this thing
    my $w=$self->timer(KICKME,{at=>time,interval=>1},$proc);
    $proc->watchers($w);
  }
  $self->timer(TIMEOUT,{at=>time+1},$data);
  return(NOOP,$data);
}

# stop all processes in group
sub haltgrp
{
  my ($self,$data)=@_;
  my $db=$self->{db};
  my $group=$self->{group};
  my (@proc) = $db->get('Cluster::Init::Process', {group=>$group});
  for my $proc (@proc)
  {
    next if $proc->configured;
    next if $proc->{kickme};
    my $tag = $proc->{tag};
    debug "halting $tag";
    # slap a kickme sign on this thing
    my $w=$self->timer(KICKME,{at=>time,interval=>1},$proc);
    $proc->watchers($w);
  }
  $self->timer(TIMEOUT,{at=>time+1},$data);
  return(NOOP,$data);
}

sub destruct
{
  my $self=shift;
  my $db=$self->{db};
  my $group=$self->{group};
  if ($db)
  {

lib/Cluster/Init/Group.pm  view on Meta::CPAN

  my ($self,$data)=@_;
  my $db=$self->{db};
  my $group=$self->{group};
  my $level=$data->{level};
  affirm { defined($level) };
  my (@proc) = $db->get('Cluster::Init::Process', {group=>$group});
  for my $proc (@proc)
  {
    next if $proc->haslevel($level);
    next if $proc->configured;
    $self->timer(TIMEOUT,{at=>time+1},$data);
    return(NOOP,$data);
  }
  return(OLD_STOPPED,$data);
}
  
sub ckhalt
{
  my ($self,$data)=@_;
  my $db=$self->{db};
  my $group=$self->{group};

lib/Cluster/Init/Group.pm  view on Meta::CPAN

  my $stillthere;
  for my $proc (@proc)
  {
    debug "trying to halt: ".$proc->{tag}." ".$proc->state;
    $proc->stop;
    $self->retire($proc) if $proc->configured;
    $stillthere++;
  }
  if ($stillthere)
  {
    $self->timer(TIMEOUT,{at=>time+1},$data);
    return(NOOP,$data);
  }
  return(ALL_HALTED,$data);
}
  
# Garbage collect old, retired, or changed processes.  Assumes old
# processes have already been stopped gracefully.  Note that we don't
# try to do a soft stop here -- procs will get kill -9 if their
# cltab entry has been changed or deleted; might want to improve
# this in the future.  For now, the workaround is to always do a

lib/Cluster/Init/Process.pm  view on Meta::CPAN

  my $elapsed = time() - $last;
  $hits++ if $elapsed < 1;
  $hits-- if $elapsed > 1;
  $hits = 0  if $hits < 0;
  debug $self->{tag}." $hits $elapsed";
  $self->{ckfreq}{'last'}=time();
  $self->{ckfreq}{'hits'}=$hits;
  if ($hits > 5)
  {
    warn $self->{tag}." respawning too rapidly: sleeping 60 seconds\n";
    $self->timer(CONTINUE,{at=>time+60},$data);
    return(TOO_RAPID,$data);
  }
  return(CONTINUE,$data);
}

sub xeq
{
  my ($self,$data)=@_;
  my $cmd=$self->{cmd};
  my $tag=$self->{tag};

lib/Cluster/Init/Process.pm  view on Meta::CPAN

sub STOPPING_enter
{
  my ($self,$oldstate,$newstate,$action,$data)=@_;
  debug __PACKAGE__.": newstate=>'$newstate', action=>'".$newstate."_enter'\n";
  my $tag = $self->{tag};
  my $pid = $self->{pid};
  debug "stopping $tag $pid";
  $self->{sig}=2;
  $self->{timeout}=0;
  $self->timer(TIMEOUT,{at=>time+$self->{timeout}});
}

sub killproc
{
  my ($self,$data)=@_;
  my $tag = $self->{tag};
  my $pid = $self->{pid};
  my $sig = $self->{sig};
  debug "kill $sig,$pid ($tag)";
  kill($sig,$pid);
  $self->{sig}=9 if $sig == 15;
  $self->{sig}=15 if $sig == 2;
  $self->{timeout}+=5;
  $self->timer(TIMEOUT,{at=>time+$self->{timeout}});
  return(NOOP,$data);
}

sub haslevel
{
  my ($self,$cklevel)=@_;
  my $level=$self->{level};
  my @level;
  if ($level eq $cklevel)
  {

lib/Cluster/Init/Util.pm  view on Meta::CPAN

  debug "$desc: calling tick($event,$data)";
  $self->tick($event,$data);
}

sub event
{
  my $self=shift;
  my $event=shift;
  debug "queue event $event";
  my $data=shift || {};
  $self->timer($event,{at=>time},$data);
}

sub watcher
{
  my $self=shift;
  my $type=shift;
  my $event=shift;
  debug "create $type $event";
  my $parm=shift || {};
  my $olddata=shift || {};

lib/Cluster/Init/Util.pm  view on Meta::CPAN

    # let it finish any pending requests -- primarily catching CHLD
    # sweep() while $w->pending;
    $w->cancel;
    my @watchers = grep {$_ && $_!=$w} $self->watchers;
    $self->{watchers}=\@watchers;
  }
  return $self->watchers;
}

sub idle     { shift->watcher('idle',  @_) }
sub timer    { shift->watcher('timer', @_) }
sub io       { shift->watcher('io',    @_) }
sub var      { shift->watcher('var',   @_) }
sub sigevent { shift->watcher('signal',@_) }

sub fields
{
  my $self=shift;
  my $class = ref $self;
  affirm { $class };
  my @field=@_;

lib/Cluster/Init/Util.pm  view on Meta::CPAN

    {
      my ($event,@res) = eval ($code);
      unless(defined $event)
      {
	die "$class: '$code' died: $@\n";
      }
      debug "$class: '$code' returned '$event'\n";
      $self->event($event,@res) if $event; # =~ /^[A-Z]+[A-Z0-9]+$/;
    }
  }
  # $self->timer("foo",{at=>time});
  # $DB::single=1 if $newstate eq "DONE";
  # `strace -o /tmp/t1 -p $$` if $newstate eq "DONE";
}

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

sub destruct
{
  my $self=shift;
  my $debug="destruct ";
  $debug.= $self->{tag} || $self;
  $debug.=" ";
  $debug.= $self->{name} || " ";

t/utils.pl  view on Meta::CPAN

  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;