#  Copyright (c) 1997-2006
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-----------------------------------------------------------------------------
#  $Project: polymake $$Id: BackgroundProcess.pm 6925 2006-02-01 21:04:04Z gawrilow $

use strict;
use namespaces;

package Poly::Background::Watcher;
use POSIX ':sys_wait_h';

use Struct (
   '%active',	# pid => something to destroy on termination
);

sub gather_zombies {
   my ($self)=@_;
   while (keys %{$self->active} && (my $pid=waitpid(-1, WNOHANG)) > 0) {
      delete $self->active->{$pid};
   }
   $self;
}

sub DESTROY {
   my ($self)=@_;
   while (keys %{$self->active}) {
      my $pid=waitpid(-1, 0);
      delete $self->active->{$pid};
   }
}

package Poly::BackgroundProcess;

sub new {
   my $class=shift;
   my $to_destroy=  $_[0] eq "to_destroy" && do { shift, shift };
   my $pid=fork;
   if (!$pid) {
      die "BackgroundProcess: fork failed: $!\n" if !defined($pid);
      exec @_
      or do {
	 my ($progname)= @_==1 ? $_[0] =~ /^\s*(\S+)/ : @_;
	 print STDERR "BackgroundProcess: could not run $progname: $!\n";
	 exec "false";	# avoid executing global destructors
      }
   }
   ( $main::global{Background} ||= new Poly::Background::Watcher )
      ->gather_zombies ->active->{$pid}=$to_destroy;
   return $pid;
}

1


syntax highlighted by Code2HTML, v. 0.9.1