Return to sampleexternal.pl CVS log

Up to [LON-CAPA] / loncom / homework / templates

Bug #6452: partial correctness from externalresponse

#!/usr/bin/perl
$|=1;

use Safe;
use strict;

#
# Sample evaluation script for externalresponse
# If you do this for real, this script should be on another server.
# On that server, it could do anything: run simulations, access databases, run Java, etc, etc.
# Make sure, though, that the student submissions cannot crash or destroy your server.
# This sample script just runs the student code in a Perl safe environment to show how this works.
#

# Header
print "Content-type: text/html\n\n";

# Load POST variables into hash %FORM
my %FORM=();
my $buffer;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
foreach my $pair (split(/&/, $buffer)) {
   my ($name, $value) = split(/=/, $pair);
   $value =~ tr/+/ /;
   $value =~ s/%(..)/pack("C", hex($1))/eg;
   $FORM{$name} = $value;
}

#
# ==== This is where your logic needs to be implemented
#

# Ready to do stuff
# Do this in a Safe compartment

my $compartment = new Safe;

# First assume that everything is wonderful 

my $award='EXACT_ANS';
my $message='';

#
# Passing test cases in the format argument=result,argument=result,...
# 
foreach my $testcase (split(/\,/,$FORM{'LONCAPA_correct_answer'})) {
   my ($value,$result)=split(/\=/,$testcase);
# Execute the student code and call the expected function
   my $studentanswer=$compartment->reval($FORM{'LONCAPA_student_response'}.'&factorial('.$value.')');
# A syntax error occurred
   if ($@) {
      $award='WRONG_FORMAT';
      $message='Syntax error: '.$@;
      last;
   }
# The result is not correct for a test case
   unless ($studentanswer==$result) {
      $award='INCORRECT';
      $message="Returned wrong result.";
      last;
   }   
}

#
# ==== The remainder is sending results $award and $message back to LON-CAPA
#

# Send result back to LON-CAPA in standard format
# Possible responses
# 'EXTRA_ANSWER','MISSING_ANSWER', 'ERROR',
# 'NO_RESPONSE',
# 'TOO_LONG', 'UNIT_INVALID_INSTRUCTOR',
# 'UNIT_INVALID_STUDENT', 'UNIT_IRRECONCIBLE',
# 'UNIT_FAIL', 'NO_UNIT',
# 'UNIT_NOTNEEDED', 'WANTED_NUMERIC',
# 'BAD_FORMULA', 'NOT_FUNCTION', 'WRONG_FORMAT',
# 'INTERNAL_ERROR', 'SIG_FAIL', 'INCORRECT',
# 'MISORDERED_RANK', 'INVALID_FILETYPE',
# 'EXCESS_FILESIZE', 'FILENAME_INUSE',
# 'DRAFT', 'SUBMITTED', 'SUBMITTED_CREDIT',
# 'ANONYMOUS', 'ANONYMOUS_CREDIT',
# 'ASSIGNED_SCORE', 'APPROX_ANS',
# 'EXACT_ANS','COMMA_FAIL'
#
# plus a free-form $message.
#
# For partial correctness, awarddetail needs to be ASSIGNED_SCORE
# The partial score would be in <awarded>
#

print (<<ENDOUT);
<loncapagrade>
    <awarddetail>$award</awarddetail>
    <message>$message</message>
    <awarded></awarded>
</loncapagrade>
ENDOUT
exit;