#! /usr/bin/perl -w

# This is a wrapper around *jade.  Some versions of *jade have the
# nasty habit of returning a zero exit status, even when they detected
# an error.  This scripts scans the output on-the-fly, and exits 1 if
# it finds an error.

# It also filters out those highly poluting "DTDDECL catalog entries
# are not supported" warnings that openjade 1.3.1 prints (presumably a
# limitation of opensp 1.3.4, to be lifted if/when a 1.3.2 is released
# with opensp-1.5 support, or when openjade-1.4 becomes usable).

use strict;
use POSIX;			# for WEXITSTATUS & Co

# check usage
#die "command to run must be one single argument" unless $#ARGV == 0;

pipe RDHDL, WRHDL or die "pipe";


# mechanism to record child termination

my $childlives = 1;
sub hdl {
  $childlives = 0;
}
$SIG{CHLD} = \&hdl;

my $pid = fork;
die "fork" unless defined $pid;

# run child

if ($pid == 0) {
  # child

  $SIG{CHLD} = 'DEFAULT';

  close RDHDL;
  open (STDERR, ">&WRHDL");
  close WRHDL;

  exec @ARGV or die "exec";

  # NOTREACHED
  exit 1;
}

close WRHDL;

# record errors

my $errors = 0;
do {
  # don't go further if we have nothing to read yet
  my ($rin, $win, $ein);
  $rin = $win = '';
  vec($rin,fileno(RDHDL),1) = 1;
  $ein = $rin;
  select ($rin, $win, $ein, undef) or die "select";

  while (<RDHDL>) {
    $errors++ if m/:[0-9]*:[0-9]*:E:/;
    print STDERR $_ unless m/:W: DTDDECL catalog entries are not supported/;
  }
} while $childlives;

# wait for child to get its exit status
my $kid = wait;
die "death of unexpected child $kid" if $kid != $pid;

if (WIFEXITED($?)) {
  if (WEXITSTATUS($?) == 0) {
    die "command found $errors error(s) but forgot to set exit status"
      if $errors > 0;
  } else {
    exit (WEXITSTATUS($?));
  }
} elsif (WIFSIGNALED($?)) {
  printf STDERR "command got signal %d\n", WTERMSIG($?);
  raise (WTERMSIG($?));
} elsif (WIFSTOPPED($?)) {
  printf STDERR "command stopped by signal %d\n", WSTOPSIG($?);
  die "unexpected condition";
} else {
  die "invalid status $?";
}

exit 0;
