# 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