--- loncom/homework/inputtags.pm 2000/12/12 22:35:52 1.17 +++ loncom/homework/inputtags.pm 2004/03/26 20:10:42 1.137 @@ -1,280 +1,723 @@ # The LearningOnline Network with CAPA # input definitons +# +# $Id: inputtags.pm,v 1.137 2004/03/26 20:10:42 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ package Apache::inputtags; +use HTML::Entities(); use strict; +use Apache::loncommon; +use Apache::lonlocal; -sub BEGIN { - &Apache::lonxml::register('Apache::inputtags',('textarea','textline','datasubmission')); +BEGIN { + &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline')); } sub initialize_inputtags { - @Apache::inputtags::input=(); - @Apache::inputtags::inputlist=(); - @Apache::inputtags::response=(); - @Apache::inputtags::responselist=(); - @Apache::inputtags::answergroup=(); - $Apache::inputtags::part=''; - %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=(); + # submission it was used in + @Apache::inputtags::previous_version=(); + # id of current part, 0 means that no part is current + # (inside only + $Apache::inputtags::part=''; + # list of all part ids seen + @Apache::inputtags::partlist=(); + # 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 all ids, for , these get join()ed and prepended + @Apache::inputtags::import=(); + # list of all import ids seen + @Apache::inputtags::importlist=(); + # just used to note whether we have seen a response that isn't in a part + $Apache::inputtags::response_with_no_part=0; +} + +sub check_for_duplicate_ids { + my %check; + foreach my $id (@Apache::inputtags::partlist, + @Apache::inputtags::responselist, + @Apache::inputtags::importlist) { + $check{$id}++; + } + my @duplicates; + foreach my $id (sort(keys(%check))) { + if ($check{$id} > 1) { + push(@duplicates,$id); + } + } + if (@duplicates) { + &Apache::lonxml::error("Duplicated ids found, problem will operate incorrectly. Duplicated ids seen: ",join(', ',@duplicates)); + } } 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; } sub end_input { - pop @Apache::inputtags::input; - return ''; + pop @Apache::inputtags::input; + return ''; } -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 ''; +sub addchars { + my ($fieldid,$addchars)=@_; + my $output=''; + foreach (split(/\,/,$addchars)) { + $output.=''.$_.' '; + } + return $output; +} + +sub start_textfield { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + my $result = ""; + my $id = &start_input($parstack,$safeeval); + my $resid=$Apache::inputtags::response[-1]; + if ($target eq 'web') { + $Apache::lonxml::evaluate--; + if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { + my $partid=$Apache::inputtags::part; + my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.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; } + my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval); + $result=''; + if ($addchars) { + $result.=&addchars('HWVAL_'.$resid,$addchars); + } + $result.= '"; + } + } elsif ($target eq 'edit') { + $result=&Apache::edit::end_table(); + } + &end_input; + return $result; } 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') { + $Apache::lonxml::evaluate--; + my $partid=$Apache::inputtags::part; + my $id=$Apache::inputtags::response[-1]; + if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { + my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval); + my $maxlength; + if ($size eq '') { $size=20; } else { + if ($size < 20) { $maxlength=$size; } + } + my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"}); + if ($Apache::lonhomework::type ne 'exam') { + my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval); + $result=''; + if ($addchars) { + $result.=&addchars('HWVAL_'.$id,$addchars); + } + $result.= ''; + } + } else { + #right or wrong don't show what was last typed in. + #$result=''.$oldresponse.''; + $result=''; + } + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token); + $result.=&Apache::edit::text_arg('Size:','size',$token,'5'). + &Apache::edit::text_arg + ('Click-On Texts (comma sep):','addchars',$token,10).""; + $result.=&Apache::edit::end_table; + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size','addchars'); + if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } + } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') { + my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval); + if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';} + $result='\framebox['.$size.'][s]{\tiny\strut}'; + } + return $result; } sub end_textline { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - return ""; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + if ($target eq 'web') { $Apache::lonxml::evaluate++; } + elsif ($target eq 'edit') { return ('','no'); } + return ""; +} + +sub start_hiddenline { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + my $result = ""; + if ($target eq 'web') { + $Apache::lonxml::evaluate--; + if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { + my $partid=$Apache::inputtags::part; + my $id=$Apache::inputtags::response[-1]; + my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"}); + if ($Apache::lonhomework::type ne 'exam') { + $result= ''; + } + } + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token); + $result.=&Apache::edit::end_table; + } + return $result; } -#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.submit'}) { -# } -# if ($showbutton > 0) { $result.=$button } -# } -# pop @Apache::inputtags::answergroup; -# return $result; -#} - - -sub start_datasubmission { -} - -sub end_datasubmission { - my ($target,$token,$parstack,$parser,$safeeval)=@_; - if ( $target == 'web' ) { - return ''; - } - return ''; +sub end_hiddenline { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + if ($target eq 'web') { $Apache::lonxml::evaluate++; } + elsif ($target eq 'edit') { return ('','no'); } + return ""; +} + +sub checkstatus { + my ($value,$awardref,$msgref)=@_; + for (my $i=0;$i<=$#$awardref;$i++) { + if ($$awardref[$i] eq $value) { + return ($$awardref[$i],$$msgref[$i]); + } + } + return(undef,undef); } 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 ($awardref,$msgref)=@_; + my $result=undef; + my $award; + my $msg; + if ($#$awardref == -1) { $result = "NO_RESPONSE"; } + if ($result eq '' ) { + my $blankcount; + foreach $award (@$awardref) { + if ($award eq '') { + $result='MISSING_ANSWER'; + $blankcount++; + } + } + if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; } + } + if (defined($result)) { return ($result,$msg); } + foreach my $possibleaward ('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', 'SIG_FAIL', 'INCORRECT', + 'MISORDERED_RANK', 'INVALID_FILETYPE', + 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE', + 'APPROX_ANS', 'EXACT_ANS') { + ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref); + if (defined($result)) { return ($result,$msg); } + } + return ('ERROR',undef); } sub decideoutput { - my ($award)=@_; - my $message=''; - my $button=0; - if ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { - $message = "Correct computer gets %s"; - $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,$awardmsg,$solved,$previous,$target)=@_; + my $message=''; + my $button=0; + my $previousmsg; + my $bgcolor='orange'; + my %possiblecolors = + ( 'correct' => '#aaffaa', + 'charged_try' => '#ffaaaa', + 'not_charged_try' => '#ffffaa', + 'no_message' => '#fffff', + ); + if ($previous) { $previousmsg=&mt('You have entered that answer before'); } + + if ($solved =~ /^correct/) { + if ($award eq 'ASSIGNED_SCORE') { + $message = &mt("A score has been assigned."); + } else { + if ($target eq 'tex') { + $message = '\textbf{'.&mt('You are correct.').'}'; + } else { + $message = "".&mt('You are correct.').""; + } + unless ($ENV{'course.'. + $ENV{'request.course.id'}. + '.disable_receipt_display'} eq 'yes') { + $message.=(($target eq 'web')?'
':' '). + &mt('Your receipt is').' '.&Apache::lonnet::receipt($Apache::inputtags::part). + (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):''); + } + } + $bgcolor=$possiblecolors{'correct'}; + $button=0; + $previousmsg=''; + } elsif ($solved =~ /^excused/) { + if ($target eq 'tex') { + $message = ' \textbf{'.&mt('You are excused from the problem.').'} '; + } else { + $message = "".&mt('You are excused from the problem.').""; + } + $bgcolor=$possiblecolors{'charged_try'}; + $button=0; + $previousmsg=''; + } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { + if ($solved =~ /^incorrect/ || $solved eq '') { + $message = &mt("Incorrect"); + $bgcolor=$possiblecolors{'charged_try'}; + $button=1; + } else { + $message = "".&mt('You are correct.').""; + unless ($ENV{'course.'. + $ENV{'request.course.id'}. + '.disable_receipt_display'} eq 'yes') { + $message.=(($target eq 'web')?'
':' '). + 'Your receipt is '.&Apache::lonnet::receipt($Apache::inputtags::part). + (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):''); + } + $bgcolor=$possiblecolors{'correct'}; + $button=0; + $previousmsg=''; + } + } elsif ($award eq 'NO_RESPONSE') { + $message = ''; + $bgcolor=$possiblecolors{'no_feedback'}; + $button=1; + } elsif ($award eq 'MISSING_ANSWER') { + $message = &mt('Some items were not submitted.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button = 1; + } elsif ($award eq 'ERROR') { + $message = &mt('An error occured while grading your answer.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button = 1; + } elsif ($award eq 'TOO_LONG') { + $message = &mt("The submitted answer was too long."); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'WANTED_NUMERIC') { + $message = &mt("This question expects a numeric answer."); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'MISORDERED_RANK') { + $message = &mt('You have provided an invalid ranking'); + if ($target ne 'tex') { + $message.=', '.&mt('please refer to').' '.&Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems').'.'; + } + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'INVALID_FILETYPE') { + $message = &mt('The filetype extension of the file you uploaded is not allowed.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'SIG_FAIL') { + $message = &mt("Significant figures are incorrect, you provided [_1] significant figures while [_2] to [_3] were expected. Submission not graded.",(split(/:/,$awardmsg))); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'UNIT_INVALID_INSTRUCTOR') { + $message = &mt('Error in instructor specifed unit. This error has been reported to the instructor.', $awardmsg); + if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'UNIT_INVALID_STUDENT') { + $message = &mt('Unable to interpret units. Computer reads units as "[_1]"', + $awardmsg); + if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'UNIT_FAIL' || $award eq 'UNIT_IRRECONCIBLE') { + $message = &mt('Units incorrect. Computer reads units as "[_1]"', + $awardmsg); + if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'UNIT_NOTNEEDED') { + $message = &mt('Only a number required. Computer reads units of "[_1]"',$awardmsg); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'NO_UNIT') { + $message = &mt("Units required"); + if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')}; + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'BAD_FORMULA') { + $message = &mt("Unable to understand formula"); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'INCORRECT') { + $message = &mt("Incorrect"); + $bgcolor=$possiblecolors{'charged_try'}; + $button=1; + } elsif ($award eq 'SUBMITTED') { + $message = &mt("Your submission has been recorded."); + $bgcolor=$possiblecolors{'correct'}; + $button=1; + } elsif ($award eq 'DRAFT') { + $message = "A draft copy has been saved."; + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'ASSIGNED_SCORE') { + $message = "A score has been assigned."; + $bgcolor=$possiblecolors{'correct'}; + $button=0; + } else { + $message = &mt("Unknown message").": $award"; + $button=1; + } + if (lc($Apache::lonhomework::problemstatus) eq 'no' && + $Apache::inputtags::status[-1] ne 'SHOW_ANSWER') { + $message = &mt("Answer Submitted: Your final submission will be graded after the due date."); + $bgcolor=$possiblecolors{'correct'}; + $button=1; + } + return ($button,$bgcolor,$message,$previousmsg); +} + +sub removealldata { + my ($id)=@_; + foreach my $key (keys(%Apache::lonhomework::results)) { + if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) { + &Apache::lonxml::debug("Removing $key"); + delete($Apache::lonhomework::results{$key}); + } + } } 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,$msg,$id,$previously_used) = @_; + # if the student already has it correct, don't modify the status + if (!$Apache::lonhomework::scantronmode && + $Apache::inputtags::status['-1'] ne 'CAN_ANSWER' && + $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') { + $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award; + return ''; + } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~ + /^correct/ || $Apache::lonhomework::scantronmode || + lc($Apache::lonhomework::problemstatus) eq 'no') { + #handle assignment of tries and solved status + my $solvemsg; + if ($Apache::lonhomework::scantronmode) { + $solvemsg='correct_by_scantron'; + } else { + $solvemsg='correct_by_student'; + } + if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) { + $Apache::lonhomework::results{"resource.$id.afterduedate"}=''; + } + if ( $award eq 'ASSIGNED_SCORE') { + $Apache::lonhomework::results{"resource.$id.tries"} = + $Apache::lonhomework::history{"resource.$id.tries"} + 1; + $Apache::lonhomework::results{"resource.$id.solved"} = + $solvemsg; + my $numawards=scalar(@Apache::inputtags::response); + $Apache::lonhomework::results{"resource.$id.awarded"} = 0; + foreach my $res (@Apache::inputtags::response) { + $Apache::lonhomework::results{"resource.$id.awarded"}+= + $Apache::lonhomework::results{"resource.$id.$res.awarded"}; + } + if ($numawards > 0) { + $Apache::lonhomework::results{"resource.$id.awarded"}/= + $numawards; + } + } elsif ( $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"} = + $solvemsg; + $Apache::lonhomework::results{"resource.$id.awarded"} = '1'; + } elsif ( $award eq 'INCORRECT' ) { + $Apache::lonhomework::results{"resource.$id.tries"} = + $Apache::lonhomework::history{"resource.$id.tries"} + 1; + if (lc($Apache::lonhomework::problemstatus) eq 'no') { + $Apache::lonhomework::results{"resource.$id.awarded"} = 0; + } + $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 'DRAFT' ) { + $Apache::lonhomework::results{"resource.$id.solved"} = ''; + } elsif ( $award eq 'NO_RESPONSE' ) { + #no real response so delete any data that got stored + &removealldata($id); + return ''; + } else { + $Apache::lonhomework::results{"resource.$id.solved"} = + 'incorrect_attempted'; + if (lc($Apache::lonhomework::problemstatus) eq 'no') { + $Apache::lonhomework::results{"resource.$id.tries"} = + $Apache::lonhomework::history{"resource.$id.tries"} + 1; + $Apache::lonhomework::results{"resource.$id.awarded"} = 0; + } + } + if (defined($msg)) { + $Apache::lonhomework::results{"resource.$id.awardmsg"} = $msg; + } + # did either of the overall awards chage? If so ignore the + # previous check + if (($Apache::lonhomework::results{"resource.$id.awarded"} eq + $Apache::lonhomework::history{"resource.$id.awarded"}) && + ($Apache::lonhomework::results{"resource.$id.solved"} eq + $Apache::lonhomework::history{"resource.$id.solved"})) { + # 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') { + if (lc($Apache::lonhomework::problemstatus) ne 'no') { + 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, but save + #the list of collaborators. + &removealldata($id); + #and since they didn't do anything we were never here + return ''; + } else { + $Apache::lonhomework::results{"resource.$id.previous"} = '0'; + } + } + } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~ + /^correct/ ) { + #delete all data as they student already has it correct + &removealldata($id); + #and since they didn't do anything we were never here + return ''; + } + $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.submit'}) { - 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 ($target) = @_; + my $id = $Apache::inputtags::part; + my $response=''; + if ( defined $ENV{'form.submitted'}) { + my (@awards,@msgs); + foreach $response (@Apache::inputtags::response) { + &Apache::lonxml::debug("looking for response.$id.$response.awarddetail"); + my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"}; + &Apache::lonxml::debug("keeping $value from $response for $id"); + push (@awards,$value); + $value=$Apache::lonhomework::results{"resource.$id.$response.awardmsg"}; + &Apache::lonxml::debug("got message $value from $response for $id"); + push (@msgs,$value); } - } - my $finalaward = &finalizeawards(@awards); - &Apache::lonxml::debug("final award $finalaward"); - &setgradedata($finalaward,$id); + my ($finalaward,$msg) = &finalizeawards(\@awards,\@msgs); + my $previously_used; + if ( $#Apache::inputtags::previous eq $#awards ) { + my $match=0; + my @matches; + foreach my $versionar (@Apache::inputtags::previous_version) { + foreach my $version (@$versionar) { + $matches[$version]++; + } + } + foreach my $elem (@matches) {if ($elem eq ($#awards+1)) {$match=1;}} + if ($match) { + $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, message $msg"); + &setgradedata($finalaward,$msg,$id,$previously_used); } - } - return $result; + return ''; } sub gradestatus { - my ($id) = @_; - my $showbutton = 1; - my $message = ''; - my $trystr=''; + my ($id,$target) = @_; + my $showbutton = 1; + my $bgcolor = ''; + my $message = ''; + my $latemessage = ''; + my $trystr=''; my $button=''; - - my ($date,$passed) = &Apache::lonhomework::check_date("OPEN_DATE",$id); + my $previousmsg=''; - if ( $passed ) { - 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); - } - my $tries = $Apache::lonhomework::history{"resource.$id.tries"}; - my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); - &Apache::lonxml::debug("goit maxtries of :$maxtries:"); - if ( $tries eq '' ) { $tries = '0'; } - if ( $maxtries eq '' ) { $maxtries = '2'; } - if ( $showbutton ) { - $trystr = "

Tries $tries/$maxtries"; - } - if ( $tries >= $maxtries ) { $showbutton = 0; } - if ( $showbutton ) { - $button = '

'; + my $status = $Apache::inputtags::status['-1']; + &Apache::lonxml::debug("gradestatus has :$status:"); + if ( $status ne 'CLOSED' && $status ne 'UNAVAILABLE' && + $status ne 'INVALID_ACCESS') { + my $award = $Apache::lonhomework::history{"resource.$id.award"}; + my $solved = $Apache::lonhomework::history{"resource.$id.solved"}; + my $previous = $Apache::lonhomework::history{"resource.$id.previous"}; + my $awardmsg = $Apache::lonhomework::history{"resource.$id.awardmsg"}; + &Apache::lonxml::debug("Found Award |$award|$solved|$awardmsg"); + if ( $award ne '' || $solved ne '') { + &Apache::lonxml::debug('Getting message'); + ($showbutton,$bgcolor,$message,$previousmsg) = + &decideoutput($award,$awardmsg,$solved,$previous,$target); + if ($target eq 'tex') { + $message='\vskip 2 mm '.$message.' '; + } else { + $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 are set to negative turn off the Tries/Button and messages + if (defined($maxtries) && $maxtries < 0) { return ''; } + if ( $tries eq '' ) { $tries = '0'; } + if ( $maxtries eq '' ) { $maxtries = '2'; } + if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } + my $tries_text=&mt('Tries'); + if ( $Apache::lonhomework::type eq 'survey') { $tries_text=&mt('Submissions'); } + if ( $showbutton ) { + if ($target eq 'tex') { + if ($ENV{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam') { + $trystr = ' {\vskip 1 mm \small \textit{'.$tries_text.'} '.$tries.'/'.$maxtries.'} \vskip 2 mm '; + } else { + $trystr = '\vskip 0 mm '; + } + } else { + $trystr = "".$tries_text." $tries"; + if($ENV{'request.state'} ne 'construct') { + $trystr.="/$maxtries"; + } else { + if (defined($Apache::inputtags::params{'maxtries'})) { + $trystr.="/".$Apache::inputtags::params{'maxtries'}; + } + } + $trystr.=""; + } + } + if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;} + if ( $showbutton ) { + if ($target ne 'tex') { + $button = ''; + } + } + if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) { + #last submissions was after due date + if ($target eq 'tex') { + $latemessage=' The last submission was after the Due Date '; + } else { + $latemessage="The last submission was after the Due Date"; + } + } + } + my $output= $previousmsg.$latemessage.$message.$trystr; + if ($output =~ /^\s*$/) { + return $button; + } else { + if ($target eq 'tex') { + return $button.' \vskip 0 mm '.$output.' '; + } else { + return ''.$output.'
'.$button.'
'; + } } - } - return $button.$message.$trystr; } 1; __END__