# vowpal.pm

package vowpal;

use warnings;
use strict;

use POSIX qw (tmpnam mkfifo);
use IO::File;
use IO::Pipe;
use IO::Poll;

sub new ($$)
{
  my $class = shift;
  my $args = shift;

  my $pred_pipename = tmpnam () or die $!;
  my $pred_pipe = mkfifo ($pred_pipename, 0700) or die $!;
  my $pred_fd = POSIX::open ($pred_pipename, 
                             &POSIX::O_RDONLY | 
                             &POSIX::O_NONBLOCK | 
                             &POSIX::O_NOCTTY) or die $!;
  my $pred_fh = new IO::Handle;
  $pred_fh->fdopen ($pred_fd, "r") or die $!;
  POSIX::fcntl ($pred_fh, 
                &POSIX::F_SETFL, 
                POSIX::fcntl ($pred_fh, &POSIX::F_GETFL, 0) & ~&POSIX::O_NONBLOCK);

  my $data_fh = new IO::Pipe or die $!;
  open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
  eval
    {
      open STDOUT, ">", "/dev/null" or die "Can't redirect STDOUT: $!";
      eval
        {
          open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
          eval
            {
              open STDERR, ">", "/dev/null" or die "Can't redirect STDERR: $!";
              $data_fh->writer ("vw $args -p $pred_pipename --quiet") or die $!;
              $data_fh->autoflush (1);
            };
          open STDERR, ">&", $olderr or die "Can't restore STDERR: $!";
          die $@ if $@;
        };
      open STDOUT, ">&", $oldout or die "Can't restore STDOUT: $!";
      die $@ if $@;
    };
  die $@ if $@;

  my $poll = new IO::Poll;
  $poll->mask ($data_fh => POLLOUT);
  $poll->poll ();
  $poll->remove ($data_fh);
  $poll->mask ($pred_fh => POLLIN);

  my $self = { data_fh => $data_fh,
               pred_fh => $pred_fh,
               pred_file => $pred_pipename,
               poll => $poll,
               args => $args };

  bless $self, $class;
  return $self;
}

sub send ($@)
{
  my $self = shift;

  $self->{'data_fh'}->print (@_);

  return $self;
}

sub recv ($)
{
  my $self = shift;

  $self->{'poll'}->poll ();
  return $self->{'pred_fh'}->getline ();
}

sub DESTROY
{
  my $self = shift;

  $self->{'data_fh'}->close ();
  $self->{'pred_fh'}->close ();
  unlink $self->{'pred_file'};
}

1;