#!/usr/bin/env perl

use strict;
use warnings;

use 5.010_001;

# essential libraries
use English                    qw( -no_match_vars );
use POSIX                      qw(:sys_wait_h);
use Proc::Simple;

my @cmd = @ARGV;
my $url;          # unused - function not implemented

my $child = Proc::Simple->new();
$child->start(\&child, \@cmd, $url);

# wait a bit to give child process a chance to die prematurely
sleep 1;

my $exitcode;
if ($child->poll() == 1) {
	$exitcode = 0;
	say("[parent] Command is still running.");
}
else {
	$exitcode = parse_retval( $child->exit_status() );
	say("[parent] Command has already terminated. (exit code = $exitcode)");
}

say("[parent] Terminating with exit code $exitcode.");
exit $exitcode;

sub parse_retval {
	my $retval = shift;

	my $signal        = $retval & 127;
	my $have_coredump = $retval & 128;

	my $exitcode;
	if ($retval == -1) {
		# program failed to execute
		$exitcode = 127;
	}
	elsif ($signal) {
		my $message = "W: Process died with signal $signal!";
		if ($have_coredump) {
			$message .= ' (coredump available)';
		}
		warn($message ."\n");
		$exitcode = 255;
	}
	else {
		$exitcode = $retval >> 8;
	}

	return $exitcode;
}

sub child {
	my @cmd = @{ +shift };
	my $url = shift;

	my $cmd_str = join ' ', @cmd;

	say("[child] Executing $cmd_str");

	my $retval   = system(@cmd);
	my $exitcode = parse_retval($retval);

	# TODO add URL callback
	say("[child] Exiting with exit code $exitcode.");
	exit $exitcode;
}