#  Copyright (c) 1997-2005
#  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: ProgramPipe.pm 6640 2005-12-21 16:19:26Z gawrilow $

use strict;
use namespaces;

package Poly::Pipe::Process;
use Struct (
   [ new => '$$' ],
   [ '$pid' => '#1' ],
   [ '$program' => '#2' ],
);
use POSIX qw(:sys_wait_h);

sub DESTROY {
   my $self=shift;
   waitpid $self->pid, 0;
   if (!$@  &&  $?  &&  $program) {
      my $rc=$?>>8;
      my ($prog)= $self->program =~ m'([^/\s]+)(?:\s|$)';
      die $rc > 128 ? ("$prog exited with code ", $rc>>8)
	            : ("$prog killed by signal ", $rc&127),
          "\n";
   }
}

package Poly::ProgramPipe;
use IPC::Open3;
use POSIX qw(:signal_h);
use Fcntl;
use Poly::Pipe;

#####################################################################################
#
#  Constructor:  new Poly::ProgramPipe('command', 'arg', ... );
#
#  Supports only one special, although very common communication "protocol":
#  send the source data to the program, then switch into the input mode,
#  and read all the results it has produced.
#
use Struct (
   [ '@ISA' => 'Poly::CollaborativePipe' ],
   [ '$proc' => 'undef' ],
   [ '$in' => 'undef' ],
);

sub construct {
   my $self=&_new;
   dbg_print( "running '@_'" ) if $Switches::d;
   my $out;
   my $pid=eval { open3($out, $self->in, ">&STDERR", @_) };
   if ($@) {
      $@ =~ s/^.*?://;
      $@ =~ s/ at \(eval.*$/\n/;
      if ($$ != getpgrp) {	# we are in the fork!!!
	 print STDERR $@;
	 exec "false";	# avoid executing global destructors
      }
      die $@;
   }
   $self->init($out);
   $self->proc=new Poly::Pipe::Process($pid, $_[0]);
   my $rfd=fileno($self->in);
   $channels[$rfd]=$self;
   vec($rmask,$rfd,1)=1;
   $out;
}

sub new {
   my $out=&construct;
   fcntl($out, F_SETFL, O_NONBLOCK);
   $out;
}

sub shared {
   my $out=&construct;
   fcntl($out, F_SETFD, 0);	# by default the pipe is closed in child processes (due to the implementation of Open3.)
   $out;
}

#####################################################################################
#  
#  The source data (output for us) are complete, start receiving the results
#
sub switch_to_input {
   my $self=shift;
   # flush the output buffer
   $self->WRITE while length($self->wbuffer);
   vec($wmask,$self->fd,1)=0;
   POSIX::close($self->fd);
   undef $channels[$self->fd];
   $self->fd=fileno($self->in);
   bless $self, keys(%active) ? "Poly::Pipe" : "Poly::CollaborativePipe";
}

sub alone { }

sub READ {
   (shift)->switch_to_input->READ(@_);
}

sub READLINE {
   (shift)->switch_to_input->READLINE;
}

# seems to die before started to consume input: shoot the program down
sub CLOSE {
   my $self=shift;
   $self->SUPER::CLOSE;
   kill SIGINT, $self->proc->pid;
   undef $self->proc->program;
   close($self->in);
}

1

# Local Variables:
# c-basic-offset:3
# End: