view release on metacpan or  search on metacpan

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

    # warn $tag;
    $db->ins($proc);
    $proc->start;
    my $w=$self->var(PROC,{var=>\$proc->{state}, poll=>'w'},$data);
    $proc->watchers($w);
    # $DB::single=1;
    return(NOOP,$data);
  }
  return(ALL_STARTED,$data);
}

sub ckproc
{
  my ($self,$data)=@_;
  my $db=$self->{db};
  my $group=$self->{group};
  # use $self->{level} here rather than $data->{level}; we want to
  # check against current rather than destination level (though they
  # should be the same)
  my $level=$self->{level};
  my (@proc) = $db->get('Cluster::Init::Process', {group=>$group});
  my ($done,$pass,$fail,$configured,$other,$total)=(0,0,0,0,0,0);
  for my $proc (@proc)
  {
    next unless $proc->haslevel($level);
    $total++;
    debug $proc->{tag}. " ". $proc->state;
    if ($proc->done){$done++;next}
    if ($proc->pass){$pass++;next}
    if ($proc->fail){$fail++;next}
    if ($proc->configured){$configured++;next}
    $other++;
  }
  debug "done $done pass $pass fail $fail configured $configured other $other total $total";
  return(NOOP,$data) if $other;
  return(ANY_FAILED,$data) if $fail;
  return(ALL_DONE,$data) unless $total;
  return(ALL_PASSED,$data) if $pass == $total;
  return(ALL_DONE,$data) if $done + $pass == $total;
  return(NOOP,$data) if $configured == $total;
  die "should never get here";
}

# Stop processes from other runlevels.
sub stopold
{
  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;
    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)
  {
    for my $proc ($db->get('Cluster::Init::Process', {group=>$group}))
    {
      $self->retire($proc);
    }
  }
  $self->SUPER::destruct;
  return 1;
}

sub kick
{
  my ($self,$proc)=@_;
  $proc->stop;
  return(NOOP);
}

sub ckstop
{
  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};
  my (@proc) = $db->get('Cluster::Init::Process', {group=>$group});
  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
# 'tell' to stop processes before editing cltab.
sub garbage_collect
{
  my ($self,$data)=@_;
  my $conf=$self->{conf};
  my $db=$self->{db};
  my $group=$self->{group};
  my $level=$data->{level};
  my (@oldproc) = $db->get('Cluster::Init::Process', {group=>$group});
  for my $oldproc (@oldproc)
  {
    my $tag = $oldproc->{tag};
    my ($newproc) = $conf->tag($tag);
    # deleted
    $self->retire($oldproc) unless $newproc;
    # changed 
    $self->retire($oldproc) if $newproc->{mode} ne $oldproc->{mode};
    $self->retire($oldproc) if $newproc->{cmd} ne $oldproc->{cmd};
    next if $oldproc->haslevel($level);
    # old level 
    $self->retire($oldproc);
  }
  return(CLEAN,$data);
}

sub retire
{
  my ($self,$proc)=@_;
  my $db=$self->{db};
  $proc->destruct;
  $db->del($proc);
}

sub XXXDONE_enter
{
  warn "in state DONE";
  $DB::single=1;
}

1;