#!/usr/bin/env perl

use strict;
use bytes;

# Parameter: a filename.
# Opens the file and returns an array with all its lines (with newlines
# removed).
#
sub read_file {
  # should really check that one and only one argument appears!
  my($filename, @lines)= $_[0];
  local(*FILE);
  open(FILE, $_[0])
      or die("Couldn't find \"$filename\"- pease report this error.\n");
  @lines= <FILE>;
  close(FILE);
  chomp(@lines);
  return @lines;
}

# Parameters: a multiline string (the student's output) and an array of
# regular expressions which the correct output is supposed to match (be
# derived from).
# Checks whether the string matches the regular expressions, in order, and
# returns -1 if so, otherwise returns the number (0 or more) of the
# first regular expression which didn't match.
#
sub compare {
  my($student_output, @regexps)= ($_[0], @{ $_[1] });
  my($i, $all_regexps);
  $all_regexps= join('\n', @regexps);
  if ($student_output =~ m/\A$all_regexps\Z/mix) {
    return -1;
  } else {
    for ($i= 0; $i <= $#regexps; $i++) {
      $all_regexps= join('\n', @regexps[0..$i]);
      if ($student_output !~ m/\A$all_regexps/mix) {
        return $i;
      }
    }
    # all lines of r.e. matched, but entire comparison didn't match- there
    # must have been some trailing junk at the end of the student's output
    return $i;
  }
}

# Parameter: an array of strings representing regular expressions matching
# the correct output.  For simplicity it's better to single-quote the
# strings.
# Returns another array by converting each string to a regular expression
# and adding anchors to each one.  Note it adds the i flag, which apparently
# doesn't apply to each subsidiary regular expression when mix is used above.
#
sub make_re {
  my(@ret)= @_;
  return map { chomp($_); qr/^\s*$_\s*$/i } @ret;
}

############################################################################
# main code
############################################################################

my($student_output, $numbered_student_output, $line_number, @temp,
   @student_output_lines, $numbered_student_output, $regexp_filename,
   @correct_output_regexps, $result, $result2, $program,
   $correct_output_filename, @correct_output, $numbered_correct_output,
   $stdin, $cmd_line_args, $help);

$stdin= $cmd_line_args= "";

while ($_ = $ARGV[0], /^-/) {
  shift;

  last if /^--$/;

  /^-stdin/         && ($stdin= shift, next);
  /^-command-line/  && ($cmd_line_args= shift, next);
  /^-h(e(l(p|)|)|)/ && ($help= 1, next);

  die "Unrecognized option \"$_\".\n";
}

if ($help == 1) {
  printf("Sorry, no help yet :(.");
  exit(0);
}

# should really make sure here that the correct number of arguments appeared!!!

$program= $ARGV[0];
@correct_output= read_file($ARGV[1]);
@correct_output_regexps= read_file($ARGV[2]);

@correct_output_regexps= make_re(@correct_output_regexps);

$line_number= 0;
@temp= map { $line_number++; sprintf("%04d: $_", $line_number); }
           @correct_output;
$numbered_correct_output= join("\n", @temp);

# run student's program and capture their output in a large multiline string
#
if ($stdin eq "") {
  @student_output_lines= `$program $cmd_line_args`;
} else {
  @student_output_lines= `$program $cmd_line_args < $stdin`;
}

if ($? & 127 || $? & 128) {  # check status code returned by child process

  print("Your program had a fatal execution error.\n\n");
  print("The correct output is:\n\n$numbered_correct_output\n");
  # map { print("$_\n") } @correct_output;
  exit(-1);

}

# map { print("$_\n"); }  @student_output_lines;
$line_number= 0;
@temp= map { $line_number++; sprintf("%04d: $_", $line_number); }
           @student_output_lines;
$numbered_student_output= join('', @temp);

$student_output= join('', @student_output_lines);
chomp(@student_output_lines);

$line_number= 0;

print("Your output was:\n\n$numbered_student_output\n");

$result= compare($student_output, \@correct_output_regexps);
$result2= $result + 1;

if ($result == -1) {

  print("Your output looks correct.\n");
  exit(0);

} else {

  # print("Your output seems incorrect.  The correct output is:\n\n");
  print("Your output seems incorrect.  ");
  # map { print("$_\n") } @correct_output;
  print("The correct output is:\n\n$numbered_correct_output\n");

  if ($result > $#student_output_lines) {

    print <<EOF1;

The first line of correct output not seen in your output was \#${result2}:
\"$correct_output[$result]\"

EOF1

  } else {

    print <<EOF2;

The first line of your output which doesn't look right is #${result2}:
  \"$student_output_lines[$result]\"

EOF2

  }

  exit(-1);

}

