# 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