#  Copyright (c) 1997-2004
#  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: Pipe.pm 5537 2004-12-10 15:46:40Z gawrilow $

use strict;
use namespaces;

package Poly::Pipe;
use Fcntl;
use POSIX;

#####################################################################################
#
#  Constructor:  new Pipe(FileHandle);
#
use Struct (
   '$fd',
   '$rbuffer',
   '$wbuffer',
);

declare %active;
declare @channels;
declare $rmask="";
declare $wmask="";

sub init {
   my $self=shift;
   $self->fd=fileno($_[0]);
   $active{$self}=0;
   $channels[$self->fd]=$self;
   tie *{$_[0]}, $self;
}

sub new {
   my $self=&_new;
   if (keys(%active)==1) {
      $self->not_alone;
      (each %active)->not_alone;
   }
   init($self,$_[0]);
   vec($rmask, $self->fd, 1)=1;
   shift;
}

sub TIEHANDLE { shift }

sub CLOSE {
   my $self=shift;
   vec($rmask, $self->fd, 1)=0;
   vec($wmask, $self->fd, 1)=0;
   POSIX::close($self->fd);
   delete $active{$self};
   undef $channels[$self->fd];
   if (keys(%active)==1) {
      (each %active)->alone;
   }
   bless $self, "Poly::ClosedPipe" unless @_;
}

sub DESTROY {
   my $self=shift;
   if (vec($rmask, $self->fd, 1)) {
      CLOSE($self,1);
   }
}

sub READLINE {
   my $self=shift;
   my ($l, $gotten)=(0);
   do {
      if ((my $endl=index($self->rbuffer, "\n", $l)) >= 0) {
	 return substr($self->rbuffer, 0, $endl+1, "");
      }

      $l=length($self->rbuffer);
   } while ($gotten=$self->do_read($self->fd,$self->rbuffer,1024,$l)) > 0;

   die "error reading from Pipe: $!\n" if !defined $gotten;
   undef;
}

sub PRINT {
   my $self=shift;
   $self->WRITE(join($, , @_).$\);
}

sub PRINTF {
   my $self=shift;
   $self->WRITE(sprintf(@_));
}

sub READ {
   my $self=shift;
   if (length($self->rbuffer)) {
      my (undef, $len, $offset)=@_;
      assign_min($len, length($self->rbuffer));
      if ($offset) {
	 substr($_[0],$offset)=substr($self->rbuffer,0,$len,"");
      } else {
	 $_[0]=substr($self->rbuffer,0,$len,"");
      }
      return $len;
   } else {
      $self->do_read($self->fd, @_);
   }
}

sub do_read {
   my ($self, $fd, undef, $len, $offset)=@_;
   my $gotten;
   if ($offset) {
      my $app;
      $gotten=POSIX::read($fd, $app, $len)
      and substr($_[2],$offset)=$app;
   } else {
      $gotten=POSIX::read($fd, $_[2], $len);
   }
   if (!$gotten) {
      CLOSE($self);
   }
   $gotten;
}

sub not_alone {
   bless shift, "Poly::CollaborativePipe";
}

sub WRITE {
   my $self=shift;
   my ($str, $len);
   if (@_==1) {
      $str=$_[0];  $len=length($str);
   } else {
      $str=substr($_[0],$_[2],$len=$_[1]);
   }
   my $written=POSIX::write($self->fd, $str, $len);
   if (!defined($written)) {
      if ($!==POSIX::EAGAIN) {
	 $written=0;
      } else {
	 CLOSE($self);
	 return undef;
      }
   }
   if ($written<$len) {
      $self->wbuffer=substr($str,$written,$len-$written);
      vec($wmask,$self->fd,1)=1;
      $self->not_alone if keys(%active)==1;
   }
   $len;
}

sub FILENO { shift->fd }

#####################################################################################
package Poly::ClosedPipe;
use Struct [ '@ISA' => 'Poly::Pipe' ];

sub READ { 0 }
sub WRITE { 0 }
sub CLOSE { 1 }
sub DESTROY { }

#####################################################################################
package Poly::CollaborativePipe;
use Struct [ '@ISA' => 'Poly::Pipe' ];

sub do_write {
   my $self=shift;
   if (@_) {
      $self->wbuffer .= @_==1 ? $_[0] : substr($_[0],$_[2],$_[1]);
   }
   my $written=POSIX::write($self->fd, $self->wbuffer, length($self->wbuffer));
   if (!defined($written)) {
      if ($!==POSIX::EAGAIN) {
	 $written=0;
      } else {
	 CLOSE($self);
	 return undef;
      }
   }
   if ($written == length($self->wbuffer)) {
      vec($wmask, $self->fd, 1)=0;
      $self->wbuffer="";
      $self->alone if keys %active==1;
   } else {
      substr($self->wbuffer, 0, $written)="";
   }
   $written;
}

sub do_read {
   my ($self, $fd)=@_;
   my ($rready, $wready, $gotten);
   while (select $rready=$rmask, $wready=$wmask, undef, undef) {
      if (vec($rready, $fd, 1)) {
	 return &Poly::Pipe::do_read;
      }
      foreach my $rfd (ones($wready)) {
	 do_write($channels[$rfd]);
      }
      foreach my $rfd (ones($rready)) {
	 my $pipe=$channels[$rfd];
	 Poly::Pipe::do_read($pipe, $rfd, $pipe->rbuffer, 1024, length($pipe->rbuffer));
      }
   }

   undef;
}

sub WRITE {
   my ($self)=@_;
   if (!length($self->wbuffer)) {
      return &Poly::Pipe::WRITE;
   }

   my ($rready, $wready, $gotten);
   while (select $rready=$rmask, $wready=$wmask, undef, undef) {
      if (vec($wready, $self->fd, 1)) {
	 return &do_write;
      }
      foreach my $rfd (ones($wready)) {
	 do_write($channels[$rfd]);
      }
      foreach my $rfd (ones($rready)) {
	 my $pipe=$channels[$rfd];
	 Poly::Pipe::do_read($pipe, $rfd, $pipe->rbuffer, 1024, length($pipe->rbuffer));
      }
   }

   undef;
}

sub alone {
   my $self=shift;
   if (!length($self->wbuffer)) {
      bless $self, "Poly::Pipe";
   }
}

sub not_alone { }

1