--- loncom/homework/inputtags.pm 2001/08/03 22:12:07 1.40 +++ loncom/homework/inputtags.pm 2001/08/06 18:00:11 1.41 @@ -1,355 +1,399 @@ -# 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 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 { - # 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 that 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=(); + # 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 $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; + 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,$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= '"; - } - &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,$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; + 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,$tagstack,$parstack,$parser,$safeeval)=@_; - if ($target eq 'edit') { return ('','no'); } - return ""; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_; + if ($target eq 'edit') { return ('','no'); } + return ""; } +# ======================================================= Start data submission sub start_datasubmission { - return ''; + return ''; } +# ========================================================= End data submission sub end_datasubmission { - my ($target,$token,$tagstack,$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 '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 + 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,$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; + 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 = "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); + $message = "Unknown message: $award"; + $button=1; + } + return ($button,$message,$previousmsg); } +# ============================================================== Set grade data sub setgradedata { - 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'; + 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; + $Apache::lonhomework::results{"resource.$id.award"} = $award; } +# ======================================================================= Grade sub grade { - my ($target) = @_; - my $id = $Apache::inputtags::part; - my $response=''; - if ( defined $ENV{'form.submitted'}) { - 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; - } - } - } - &Apache::lonxml::debug("final award $finalaward, $previously_used"); - &setgradedata($finalaward,$id,$previously_used); - } - return ''; + my ($target) = @_; + my $id = $Apache::inputtags::part; + my $response = ''; + if ( defined $ENV{'form.submitted'}) { + 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; + } + } + } + &Apache::lonxml::debug("final award $finalaward, $previously_used"); + &setgradedata($finalaward,$id,$previously_used); + } + return ''; } +# ========================================= Grade status (return scalar string) sub gradestatus { - 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.'
'; - } + 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. + '
'; + } } + 1; + __END__ -