package Tools::IO::FiFo;
use POSIX;
use IO::Select;
use strict;
use warnings;

# create new fifo handler
sub new
{
  my $class=shift;
  my $file=shift;

  my $self={};
  $self->{file}=$file;

  bless($self,$class);
}

sub DESTROY{ shift()->close(); }

# open pipe
sub open
{
  my $self=shift;
  my $pid = open(my $ch, "-|");

  __child($self->{file}) if($pid==0);

  return undef unless($pid);

  $self->{child_pid}=$pid;
  $self->{child_fh}=$ch;
  $self->{child_sel}=IO::Select->new($ch);
}

# close pipe
sub close
{
  my $self=shift;
  delete($self->{child_sel});

  unlink($self->{file});

  if($self->{child_pid} && kill(0,$self->{child_pid}))
  {
    kill(10,$self->{child_pid});
    waitpid($self->{child_pid},0);
  }

  close($self->{child_fh}) if($self->{child_fh});
  delete($self->{child_fh});

  delete($self->{child_pid});
}

# read pipe
sub read
{
  my $self=shift;
  my $nonblock=shift;
  $nonblock=1 unless(defined($nonblock));

  my $data='';

  if($self->{child_pid} && kill(0,$self->{child_pid}))
  {
    if($nonblock)
    {
      my $buf='';
      $data.=$buf  while(
            $self->{child_fh} &&
            $self->{child_sel}->can_read(0) &&
            sysread($self->{child_fh},$buf,1024)
        );
    }
    else
    {
      my $f=$self->{child_fh};
      $data=<$f>;
    }
  }

  return $data;
}

# handle fifo in childprocess
# fifos (named pipes) are special.
#
# A nonblocking read (sysopen fifo file with "O_NONBLOCK") is not possible on all platforms.
# It will crash the writing process, because the fifo is closed to early from the reading process
#
# Most systems also wait on "open" when a fifo is used not at "read".
# so an "alarm" handler has to be installed there to get an eventloop
# but alarm can only take seconds and that's to slow.
sub __child
{
  my $file=shift;

  exit(0) if(-p $file);

  # fifo erzeugen
  POSIX::mkfifo($file, 0666) or exit(0);

  my $do_exit=sub{
      CORE::close(STDOUT);
      unlink($file);
      exit(0);
    };

  # Signale verbinden
  # SIGTERM (15)
  $SIG{TERM}=$do_exit;
  # SIGUSR1 (10)
  $SIG{USR1}=$do_exit;

  my $sel=IO::Select->new(\*STDOUT);

  while(-p $file)
  {

    # STDOUT closed?
    $do_exit->() unless ($sel->can_write(0));

    eval{
      local $SIG{ALRM}=sub{die()};

      # open and wait for input
      alarm(1);
      CORE::open(my $fh, '<', $file);

      # read
      alarm(1);
      print <$fh>;

      alarm(0);
      CORE::close($fh);

      # wait vor 1/5 second
      # slow systems need some time for clean up.
      select(undef,undef,undef,0.2);
    };

  }
  $do_exit->();
  exit(0);
}

1;