--- loncom/homework/inputtags.pm 2001/02/19 21:02:59 1.28 +++ loncom/homework/inputtags.pm 2001/08/06 18:00:34 1.42 @@ -1,285 +1,400 @@ -# The LearningOnline Network with CAPA -# input definitons -# 2/19 Guy +# The LON-CAPA input tags +# +# Input definitions. +# +# YEAR=2000 +# 7/25,9/11,9/19,10/2,10/11,11/21,11/28,12/1,12/4,12/8,12/11 Guy Albertelli +# 12/12 Guy Albertelli +# 12/12 Gerd Kortemeyer +# 12/12,12/15,12/21 Guy Albertelli +# YEAR=2001 +# 1/4,1/5,1/6,1/10,1/15,1/24,2/19 Guy Albertelli +# 8/6 Scott Harrison package Apache::inputtags; use strict; +# ======================================================================= BEGIN sub BEGIN { - &Apache::lonxml::register('Apache::inputtags',('textarea','textline','datasubmission')); + &Apache::lonxml::register('Apache::inputtags', + ('textarea','textline','datasubmission')); } - +# ======================================================= Initialize input tags sub initialize_inputtags { - @Apache::inputtags::input=(); - @Apache::inputtags::inputlist=(); - @Apache::inputtags::response=(); - @Apache::inputtags::responselist=(); - @Apache::inputtags::answergroup=(); - $Apache::inputtags::part=''; - @Apache::inputtags::status=(); - %Apache::inputtags::params=(); + # 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 = (); + # list of whether or not a specific response was previously used + @Apache::inputtags::previous = (); + # id of current part, 0 means no part is current (inside only + $Apache::inputtags::part = ''; + # list of problem date statuses, the first element is for + #if there is a second element it is for the current + @Apache::inputtags::status = (); + #hash of defined params for the current response + %Apache::inputtags::params = (); } +# ========================================== Start input (return scalar string) sub start_input { - my ($parstack,$safeeval)=@_; - my $args =''; - if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } - my $id = &Apache::run::run("{$args;".'return $id}',$safeeval); - push (@Apache::inputtags::input,$id); - push (@Apache::inputtags::inputlist,$id); - return $id; + my ($parstack,$safeeval) = @_; + my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval); + if ($id eq '') { $id = $Apache::lonxml::curdepth; } + push (@Apache::inputtags::input,$id); + push (@Apache::inputtags::inputlist,$id); + return $id; } +# =================================================================== End input sub end_input { - pop @Apache::inputtags::input; - return ''; + pop @Apache::inputtags::input; + return ''; } +# ====================================== Start text area (return scalar string) sub start_textarea { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - my $result = ""; - my $id = &start_input($parstack,$safeeval); - if ($target eq 'web') { - $result= '"; - } - &end_input; - return ''; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + if ($target eq 'web') { + return ""; + } + &end_input; + return ''; } +# ====================================== Start text line (return scalar string) sub start_textline { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - my $result = ""; - if ($target eq 'web') { - my $args =''; - if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } - my $size = &Apache::run::run("{$args;".'return $size}',$safeeval); - if ($size eq '') { $size=20; } - my $oldresponse = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.$Apache::inputtags::response['-1'].submission"}; - $result= ''; - } - return $result; + 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 = ''; + } + if ($target eq 'edit') { + $result .= &Apache::edit::tag_start($target,$token, + &Apache::lonxml::description($token)); + $result .= &Apache::edit::text_arg('Size:','size',$token,'5'). + ''; + $result .= &Apache::edit::end_table; + } + if ($target eq 'modified') { + my $constructtag = &Apache::edit::get_new_args($token,$parstack, + $safeeval,'size'); + if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } + } + return $result; } +# =============================================================== End text line sub end_textline { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - return ""; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_; + if ($target eq 'edit') { return ('','no'); } + return ""; } -#answergroup is deprecated -#sub start_answergroup { -# my ($target,$token,$parstack,$parser,$safeeval)=@_; -# my $args =''; -# if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } -# my $id = &Apache::run::run("{$args;".'return $id}',$safeeval); -# push (@Apache::inputtags::answergroup,$id); -# if ($target == 'web') { -# -# } -# return ''; -#} -# -#sub end_answergroup { -# my ($target,$token,$parstack,$parser,$safeeval)=@_; -# return ''; # has ben deprecated -# my $args =''; -# if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } -# my $id = &Apache::run::run("{$args;".'return $id}',$safeeval); -# push (@Apache::inputtags::answergroup,$id); -# my $result=''; -# my $button=''; -# my $showbutton='1'; -# my $usedtry='1'; -# my $response=''; -# if ( $target == 'web' ) { -# if ( defined $ENV{'form.submitted'}) { -# } -# if ($showbutton > 0) { $result.=$button } -# } -# pop @Apache::inputtags::answergroup; -# return $result; -#} - - +# ======================================================= Start data submission sub start_datasubmission { + return ''; } +# ========================================================= End data submission sub end_datasubmission { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - if ( $target == 'web' ) { - return ''; - } - return ''; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + if ( $target == 'web' ) { + return ''; + } + return ''; } +# ============================================================= Finalize awards 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 '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 'APPROX_ANS') {$result=$award; last;} } - } - if ($result eq '' ) { $result='EXACT_ANS'; } - return $result + 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; } +# ====================================== Decide output (return 3 element array) sub decideoutput { - my ($award)=@_; - my $message=''; - my $button=0; - if ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { - $message = "You are correct. 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; - } else { - $message = "Unknown message: $award"; - $button=1; - } - return ($button,$message); + my ($award,$solved,$previous)=@_; + my $message=''; + my $button=0; + my $previousmsg; + + if ($previous) { $previousmsg='You have entered that answer before'; } + + if ($solved =~ /^correct/) { + $message = "You are correct. Your receipt is ". + &Apache::lonnet::receipt; + $button=0; + $previousmsg=''; + } elsif ($solved =~ /^excused/) { + $message = "You are excused from the problem."; + $button=0; + $previousmsg=''; + } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { + if ($solved =~ /^incorrect/ || $solved eq '') { + $message = "Incorrect"; + $button=1; + } else { + $message = "You are correct. Your receipt is ". + &Apache::lonnet::receipt; + $button=0; + $previousmsg=''; + } + } 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,$previousmsg); } +# ============================================================== Set grade data 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'; - } else { - $Apache::lonhomework::results{"resource.$id.solved"} = - 'incorrect_attempted'; - } - $Apache::lonhomework::results{"resource.$id.award"} = $award; + my ($award,$id,$previously_used) = @_; + # if the student already has it correct, don't modify the status + if ( $Apache::lonhomework::history{"resource.$id.solved"} !~ /^correct/ ) { + #handle assignment of tries and solved status + 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'; + } elsif ( $award eq 'NO_RESPONSE' ) { + return ''; + } else { + $Apache::lonhomework::results{"resource.$id.solved"} = + 'incorrect_attempted'; + } + + # check if this was a previous submission if it was delete the + # unneeded data and update the previously_used attribute + if ( $previously_used eq 'PREVIOUSLY_USED') { + delete($Apache::lonhomework::results{"resource.$id.tries"}); + $Apache::lonhomework::results{"resource.$id.previous"} = '1'; + } elsif ( $previously_used eq 'PREVIOUSLY_LAST') { + #delete all data as they student didn't do anything + foreach my $key (keys(%Apache::lonhomework::results)) { + if ($key =~ /^resource\.$id\./) { + &Apache::lonxml::debug("Removing $key"); + delete($Apache::lonhomework::results{$key}); + } + } + #and since they didn't do anything we were never here + return ''; + } else { + $Apache::lonhomework::results{"resource.$id.previous"} = '0'; + } + } + $Apache::lonhomework::results{"resource.$id.award"} = $award; } +# ======================================================================= Grade sub grade { - my ($target) = @_; - my $id = $Apache::inputtags::part; -# my $result=''; - my $response=''; - if ( $target == 'web' ) { + my ($target) = @_; + my $id = $Apache::inputtags::part; + my $response = ''; 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("keep ing $value from $response for $id"); - push (@awards,$value); - } else { - &Apache::lonxml::debug("skipping $value from $response for $id"); + my @awards = (); + 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); + my $previously_used; + if ( $#Apache::inputtags::previous eq $#awards ) { + $previously_used = 'PREVIOUSLY_LAST'; + foreach my $value (@Apache::inputtags::previous) { + if ($value eq 'PREVIOUSLY_USED' ) { + $previously_used = $value; + last; + } + } } - } - my $finalaward = &finalizeawards(@awards); - &Apache::lonxml::debug("final award $finalaward"); - &setgradedata($finalaward,$id); + &Apache::lonxml::debug("final award $finalaward, $previously_used"); + &setgradedata($finalaward,$id,$previously_used); } - } - return ''; + return ''; } +# ========================================= Grade status (return scalar string) 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"}; - &Apache::lonxml::debug("Found Award |$award|"); - if ( $award ne '' ) { - &Apache::lonxml::debug('Getting message'); - ($showbutton,$message) = &decideoutput($award); - $message="
$message
"; - } - 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 = "
Tries $tries/$maxtries"; - } - if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;} - if ( $showbutton ) { - $button = '
'; + my ($id) = @_; + my $showbutton = 1; + my $message = ''; + my $trystr = ''; + my $button = ''; + my $previousmsg = ''; + + 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"}; + my $previous = $Apache::lonhomework::history{"resource.$id.previous"}; + &Apache::lonxml::debug("Found Award |$award|$solved|"); + if ( $award ne '' ) { + &Apache::lonxml::debug('Getting message'); + ($showbutton,$message,$previousmsg) = + &decideoutput($award,$solved,$previous); + $message = "$message"; + if ($previousmsg) { + $previousmsg = "$previousmsg"; + } + } + 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 = "Tries $tries/$maxtries"; + } + if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') { + $showbutton = 0;} + if ( $showbutton ) { + $button = '
'; + } + } + my $output= $previousmsg.$message.$trystr; + if ($output =~ /^\s*$/) { + return $button; + } else { + return $button.''.$previousmsg.$message.$trystr. + '
'; } - } - return $button.$message.$trystr; } + 1; + __END__ -