[BACK]Return to inputtags.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework
File:  [LON-CAPA] / loncom / homework / inputtags.pm
Revision 1.35: download - view: text, annotated - select for diffs
Sat Jun 2 03:59:59 2001 UTC (23 years ago) by albertel
Branches: MAIN
CVS tags: HEAD
- added new arg $tagstack to all start_ or end_ routines

# The LearningOnline Network with CAPA
# input  definitons
# 2/19 Guy 

package Apache::inputtags;
use strict;

sub BEGIN {
  &Apache::lonxml::register('Apache::inputtags',('textarea','textline','datasubmission'));
}


sub initialize_inputtags {
  # list of current input ids
  @Apache::inputtags::input=();
  # list of all input ids seen in this problem
  @Apache::inputtags::inputlist=();
  # list of all current response ids
  @Apache::inputtags::response=();
  #list of all response ids seen in this problem
  @Apache::inputtags::responselist=();
  # id of current part, 0 means that no part is current (inside <problem> only
  $Apache::inputtags::part='';
  # list of problem date statuses, the first element is for <problem> 
  #if there is a second element it is for the current <part>
  @Apache::inputtags::status=();
  #hash of defined params for the current response
  %Apache::inputtags::params=();
}

sub start_input {
  my ($parstack,$safeeval)=@_;
  my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
  push (@Apache::inputtags::input,$id);
  push (@Apache::inputtags::inputlist,$id);
  return $id;
}

sub end_input {
  pop @Apache::inputtags::input;
  return '';
}

sub start_textarea {
  my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  my $result = "";
  my $id = &start_input($parstack,$safeeval);
  if ($target eq 'web') {
    my $oldresponse = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.$Apache::inputtags::response['-1'].submission"};
    my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
    if ( $cols eq '') { $cols = 80; }
    my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
    if ( $rows eq '') { $rows = 10; }
    $result= '<textarea name="HWVAL'.$Apache::inputtags::response['-1'].'" '.
      "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
    if ($oldresponse ne '') {
      #get rid of any startup text if the user has already responded
      &Apache::lonxml::get_all_text("/textarea",$$parser[$#$parser]);
    }
  }
  return $result;
}

sub end_textarea {
  my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  if ($target eq 'web') {
    return "</textarea>";
  } 
  &end_input;
  return '';
}

sub start_textline {
  my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  my $result = "";
  if ($target eq 'web') {
    my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
    if ($size eq '') { $size=20; }
    my $oldresponse = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.$Apache::inputtags::response['-1'].submission"};
    $result= '<input type="text" name="HWVAL'.$Apache::inputtags::response['-1'].'" value="'.$oldresponse.'" size="'.$size.'" />';
  }
  return $result;
}

sub end_textline {
  my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  return "";
}

sub start_datasubmission {
  return '';
}

sub end_datasubmission {
  my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  if ( $target == 'web' ) {
    return '<input type="submit" name="submit" value="Submit All Data" />';
  }
  return '';
}

sub finalizeawards {
  my $result='';
  my $award;
  if ($#_ == '-1') { $result = "NO_RESPONSE"; }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq '') {$result='MISSING_ANSWER'; last;}}
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} }
  }

  if ($result eq '' ) {
    foreach $award (@_) { 
      if ($award eq 'UNIT_FAIL' ||
	  $award eq 'NO_UNIT' ||
	  $award eq 'UNIT_NOTNEEDED') {
	$result=$award; last;
      }
    }
  }
  if ($result eq '' ) {
    foreach $award (@_) { 
      if ($award eq 'WANTED_NUMERIC' || 
	  $award eq 'BAD_FORMULA') {$result=$award; last;}
    }
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} }
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} }
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} }
  }
  if ($result eq '' ) {
    foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} }
  }
  if ($result eq '' ) { $result='EXACT_ANS'; }
  return $result
}

sub decideoutput {
  my ($award,$solved)=@_;
  my $message='';
  my $button=0;
  if      ($solved =~ /^correct/ || $award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
    $message = "<b>You are correct.</b> Your receipt is ".&Apache::lonnet::receipt;
    $button=0;
  } elsif ($award eq 'NO_RESPONSE') {
    $message = '';
    $button=1;
  } elsif ($award eq 'MISSING_ANSWER') {
    $message = 'Some parts were not submitted';
    $button = 1;
  } elsif ($award eq 'WANTED_NUMERIC') {
    $message = "This question expects a numeric answer";
    $button=1;
  } elsif ($award eq 'SIG_FAIL') {
    $message = "Please adjust significant figures.";# you provided %s significant figures";
    $button=1;
  } elsif ($award eq 'UNIT_FAIL') {
    $message = "Units incorrect."; #Computer reads units as %s";
    $button=1;
  } elsif ($award eq 'UNIT_NOTNEEDED') {
    $message = "Only a number required.";# Computer reads units of %s";
    $button=1;
  } elsif ($award eq 'NO_UNIT') {
    $message = "Units required";
    $button=1;
  } elsif ($award eq 'BAD_FORMULA') {
    $message = "Unable to understand formula";
    $button=1;
  } elsif ($award eq 'INCORRECT') {
    $message = "Incorrect";
    $button=1;
  } elsif ($award eq 'SUBMITTED') {
    $message = "Your submission has been recorded.";
    $button=1;
  } else {
    $message = "Unknown message: $award";
    $button=1;
  }
  return ($button,$message);
}

sub setgradedata {
  my ($award,$id) = @_;
  if ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
    $Apache::lonhomework::results{"resource.$id.tries"} =
      $Apache::lonhomework::history{"resource.$id.tries"} + 1;
    $Apache::lonhomework::results{"resource.$id.solved"} =
      'correct_by_student';
    $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
  } elsif ( $award eq 'INCORRECT' ) {
    $Apache::lonhomework::results{"resource.$id.tries"} =
      $Apache::lonhomework::history{"resource.$id.tries"} + 1;
    $Apache::lonhomework::results{"resource.$id.solved"} =
      'incorrect_attempted';
  } elsif ( $award eq 'SUBMITTED' ) {
    $Apache::lonhomework::results{"resource.$id.tries"} =
      $Apache::lonhomework::history{"resource.$id.tries"} + 1;
    $Apache::lonhomework::results{"resource.$id.solved"} =
      'ungraded_attempted';
  } else {
    $Apache::lonhomework::results{"resource.$id.solved"} =
      'incorrect_attempted';
  }
  $Apache::lonhomework::results{"resource.$id.award"} = $award;
}

sub grade {
  my ($target) = @_;
  my $id = $Apache::inputtags::part;
#  my $result='';
  my $response='';
  if ( $target == 'web' ) {
    if ( defined $ENV{'form.submitted'}) {
      my @awards = ();
      &Apache::lonxml::debug("$#Apache::inputtags::responselist");
      foreach $response (@Apache::inputtags::responselist) {
	&Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
	my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
	if ( $value ne '' ) {
	  &Apache::lonxml::debug("keeping $value from $response for $id");
	  push (@awards,$value);
	} else {
	  &Apache::lonxml::debug("skipping $value from $response for $id");
	}
      }
      my $finalaward = &finalizeawards(@awards);
      &Apache::lonxml::debug("final award $finalaward");
      &setgradedata($finalaward,$id);
    }
  }
  return '';
}

sub gradestatus {
  my ($id) = @_;
  my $showbutton = 1;
  my $message = '';
  my $trystr='';
  my $button='';
  
  my $status = $Apache::inputtags::status['-1'];
  &Apache::lonxml::debug("gradestatus has :$status:");
  if ( $status ne 'CLOSED' ) {  
    my $award = $Apache::lonhomework::history{"resource.$id.award"};
    my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
    &Apache::lonxml::debug("Found Award |$award|$solved|");
    if ( $award ne '' ) {
      &Apache::lonxml::debug('Getting message');
      ($showbutton,$message) = &decideoutput($award,$solved);
      $message="<br /><table bgcolor=\"#aaffaa\"><tr><td>$message</td></tr></table>";
    }
    my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
    my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
    &Apache::lonxml::debug("got maxtries of :$maxtries:");
    if ( $tries eq '' ) { $tries = '0'; }
    if ( $maxtries eq '' ) { $maxtries = '2'; } 
    if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
    if ( $showbutton ) {
      $trystr = "<br />Tries $tries/$maxtries";
    }
    if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}
    if ( $showbutton ) { 
      $button = '<br /><input type="submit" name="submit" value="Submit All Answers" />';
    }
  }
  return $button.$message.$trystr;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.