--- loncom/homework/inputtags.pm 2005/07/11 19:41:53 1.171 +++ loncom/homework/inputtags.pm 2007/03/15 02:54:28 1.220 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # input definitons # -# $Id: inputtags.pm,v 1.171 2005/07/11 19:41:53 albertel Exp $ +# $Id: inputtags.pm,v 1.220 2007/03/15 02:54:28 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,50 +31,75 @@ use strict; use Apache::loncommon; use Apache::lonlocal; use Apache::lonnet; +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + BEGIN { &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline')); } +# Initializes a set of global variables used during the parse of the problem. +# +# @Apache::inputtags::input - List of current input ids. +# @Apache::inputtags::inputlist - List of all input ids seen this problem. +# @Apache::inputtags::response - List of all current resopnse ids. +# @Apache::inputtags::responselist - List of all response ids seen this +# problem. +# @Apache::inputtags::hint - List of all hint ids. +# @Apache::inputtags::hintlist - List of all hint ids seen this problem. +# @Apache::inputtags::previous - List describing if specific responseds +# have been used +# @Apache::inputtags::previous_version - Submission responses were used in. +# $Apache::inputtags::part - Current part id (valid only in +# ) +# 0 if not in a part. +# @Apache::inputtags::partlist - List of part ids seen in the current +# +# @Apache::inputtags::status - List of problem statuses. First +# element is the status of the +# the remainder are for individual s. +# %Apache::inputtags::params - Hash of defined parameters for the +# current response. +# @Apache::inputtags::import - List of all ids for thes get +# join()ed and prepended. +# @Apache::inputtags::importlist - List of all import ids seen. +# $Apache::inputtags::response_with_no_part +# - Flag set true if we have seen a response +# that is not inside a +# %Apache::inputtags::answertxt - <*response> tags store correct +# answer strings for display by +# in this hash. +# %Apache::inputtags::submission_display +# - <*response> tags store improved display +# of submission strings for display by part +# end. 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::hint=(); + @Apache::inputtags::hintlist=(); @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; - # storage location so the begin <*response> tag can generate the correct - # answer string for display by the %Apache::inputtags::answertxt=(); + %Apache::inputtags::submission_display=(); } sub check_for_duplicate_ids { my %check; foreach my $id (@Apache::inputtags::partlist, @Apache::inputtags::responselist, + @Apache::inputtags::hintlist, @Apache::inputtags::importlist) { $check{$id}++; } @@ -114,15 +139,15 @@ sub addchars { } sub start_textfield { - my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ""; my $id = &start_input($parstack,$safeeval); my $resid=$Apache::inputtags::response[-1]; if ($target eq 'web') { $Apache::lonxml::evaluate--; + my $partid=$Apache::inputtags::part; + my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"},'<>&"'); 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); @@ -132,23 +157,28 @@ sub start_textfield { if ($addchars) { $result.=&addchars('HWVAL_'.$resid,$addchars); } - push @Apache::lonxml::htmlareafields,'HWVAL_'.$resid; + &Apache::lonhtmlcommon::add_htmlareafields('HWVAL_'.$resid); $result.= '

'; + } + return $result; +} + +sub needs_exam_box { + my ($tagstack) = @_; + my @tags = ('formularesponse', + 'stringresponse', + 'reactionresponse', + 'organicresponse', + ); + + foreach my $tag (@tags) { + if (grep(/\Q$tag\E/,@$tagstack)) { + return 1; + } + } + return 0; +} + sub start_textline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; + my $input_id = &start_input($parstack,$safeeval); 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') { + if (!&Apache::response::show_answer()) { my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval); my $maxlength; if ($size eq '') { $size=20; } else { - if ($size < 20) { $maxlength=$size; } + if ($size < 20) { + $maxlength = ' maxlength="'.$size.'"'; + } } - my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"},'<>&"'); + my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"}; + &Apache::lonxml::debug("oldresponse $oldresponse is ".ref($oldresponse)); + + if (ref($oldresponse) eq 'ARRAY') { + $oldresponse = $oldresponse->[$#Apache::inputtags::inputlist]; + } + $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"'); + if ($Apache::lonhomework::type ne 'exam') { my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval); $result=''; @@ -225,17 +317,27 @@ sub start_textline { } my $readonly=&Apache::lonxml::get_param('readonly',$parstack, $safeeval); - if (lc($readonly) eq 'yes') { + if (lc($readonly) eq 'yes' + || $Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') { $readonly=' readonly="readonly" '; } else { $readonly=''; } - $result.= ''; + my $name = 'HWVAL_'.$id; + if ($Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') { + $name = "none"; + } + $result.= ''; + } + if ($Apache::lonhomework::type eq 'exam' + && &needs_exam_box($tagstack)) { + $result.=&exam_box($target); } } else { #right or wrong don't show what was last typed in. - $result=''.$Apache::inputtags::answertxt{$id}.''; + my $count = scalar(@Apache::inputtags::inputlist)-1; + $result=''.$Apache::inputtags::answertxt{$id}[$count].''; #$result=''; } } elsif ($target eq 'edit') { @@ -252,10 +354,16 @@ sub start_textline { $safeeval,'size', 'addchars','readonly'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } - } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') { + } elsif ($target eq 'tex' + && $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}'; + + } elsif ($target eq 'tex' + && $Apache::lonhomework::type eq 'exam' + && &needs_exam_box($tagstack)) { + $result.=&exam_box($target); } return $result; } @@ -264,18 +372,25 @@ sub end_textline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'web') { $Apache::lonxml::evaluate++; } elsif ($target eq 'edit') { return ('','no'); } + &end_input(); return ""; } sub start_hiddenline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; + my $input_id = &start_input($parstack,$safeeval); 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"},'<>&"'); + my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"}; + if (ref($oldresponse) eq 'ARRAY') { + $oldresponse = $oldresponse->[$#Apache::inputtags::inputlist]; + } + $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"'); + if ($Apache::lonhomework::type ne 'exam') { $result= ''; @@ -285,6 +400,12 @@ sub start_hiddenline { $result=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::end_table; } + + if ( ($target eq 'web' || $target eq 'tex') + && $Apache::lonhomework::type eq 'exam' + && &needs_exam_box($tagstack)) { + $result.=&exam_box($target); + } return $result; } @@ -292,6 +413,7 @@ sub end_hiddenline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'web') { $Apache::lonxml::evaluate++; } elsif ($target eq 'edit') { return ('','no'); } + &end_input(); return ""; } @@ -301,9 +423,10 @@ sub end_hiddenline { # $which -> 'uploadedonly' -> only newly uploaded files # 'portfolioonly' -> only allow files from portfolio # 'both' -> allow files from either location +# $extratext -> additional text to go between the link and the input box # returns a table row sub file_selector { - my ($part,$id,$uploadedfiletypes,$which)=@_; + my ($part,$id,$uploadedfiletypes,$which,$extratext)=@_; if (!$uploadedfiletypes) { return ''; } my $jspart=$part; @@ -320,63 +443,111 @@ sub file_selector { $result.=&mt('Submit a file: (only one file can be uploaded)'). '

'; - my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"'); - - if ($uploadedfile) { - my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}; - push (@Apache::lonxml::extlinks,$url); - &Apache::lonnet::allowuploaded('/adm/essayresponse',$url); - my $icon=&Apache::loncommon::icon($url); - my $curfile=''.$uploadedfile.''; - $result.=&mt('Currently submitted: [_1]',$curfile); - } else { - #$result.=&mt('(Hand in a file you have prepared on your computer)'); - } + $result .= &show_past_file_submission($part,$id); } if ( $which eq 'both') { $result.='
'.''.&mt('OR:').'
'; } if ($which eq 'portfolioonly' || $which eq 'both') { - $result.=''. + $result.=$extratext.''. &mt('Select Portfolio Files').'
'. ''. '
'; - if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}=~/[^\s]/){ - my @filelist; - foreach my $file (split(',',&Apache::lonnet::unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) { - my (undef,undef,$domain,$user)=&Apache::lonxml::whichuser(); - my $url="/uploaded/$domain/$user/portfolio$file"; - my $icon=&Apache::loncommon::icon($url); - push(@filelist,''.$file.''); - } - $result.=&mt("Portfolio files previously selected: [_1]",join(', ',@filelist)); - } + $result .= &show_past_portfile_submission($part,$id); + } $result.=''; return $result; } -sub checkstatus { - my ($value,$awardref,$msgref)=@_; - for (my $i=0;$i<=$#$awardref;$i++) { - if ($$awardref[$i] eq $value) { - return ($$awardref[$i],$$msgref[$i]); - } +sub show_past_file_submission { + my ($part,$id) = @_; + my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"'); + + return if (!$uploadedfile); + + my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}; + &Apache::lonxml::extlink($url); + &Apache::lonnet::allowuploaded('/adm/essayresponse',$url); + my $icon=&Apache::loncommon::icon($url); + my $curfile=''.$uploadedfile.''; + return &mt('Currently submitted: [_1]',$curfile); + +} + +sub show_past_portfile_submission { + my ($part,$id) = @_; + if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}!~/[^\s]/){ + return; + } + my (@file_list,@bad_file_list); + foreach my $file (split(/\s*,\s*/,&unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) { + my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser(); + my $url="/uploaded/$domain/$user/portfolio$file"; + my $icon=&Apache::loncommon::icon($url); + push(@file_list,''.$file.''); + if (! &Apache::lonnet::stat_file($url)) { + &Apache::lonnet::logthis("bad file is $url"); + push(@bad_file_list,''.$file.''); + } + } + my $files = ''. + join(', ',@file_list). + ''; + my $result = &mt("Portfolio files previously selected: [_1]",$files); + if (@bad_file_list) { + my $bad_files = ''. + join(', ',@bad_file_list). + ''; + $result.='
'.&mt('These file(s) don\'t exist: [_1]',$bad_files); } - return(undef,undef); + return $result; + } +sub valid_award { + my ($award) =@_; + foreach my $possibleaward ('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', 'SIG_FAIL', 'INCORRECT', + 'MISORDERED_RANK', 'INVALID_FILETYPE', + 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE', + 'APPROX_ANS', 'EXACT_ANS','COMMA_FAIL') { + if ($award eq $possibleaward) { return 1; } + } + return 0; +} + +{ + my @awards = ('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', + 'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK', + 'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE', + 'APPROX_ANS', 'EXACT_ANS'); + my $i=0; + my %fwd_awards = map { ($_,$i++) } @awards; + my $max=scalar(@awards); + @awards=reverse(@awards); + $i=0; + my %rev_awards = map { ($_,$i++) } @awards; + sub finalizeawards { - my ($awardref,$msgref)=@_; - my $result=undef; - my $award; - my $msg; + my ($awardref,$msgref,$nameref,$reverse)=@_; + my $result; if ($#$awardref == -1) { $result = "NO_RESPONSE"; } if ($result eq '' ) { my $blankcount; - foreach $award (@$awardref) { + foreach my $award (@$awardref) { if ($award eq '') { $result='MISSING_ANSWER'; $blankcount++; @@ -384,21 +555,31 @@ sub finalizeawards { } 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','COMMA_FAIL') { - ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref); - if (defined($result)) { return ($result,$msg); } + if (defined($result)) { return ($result); } + + # these awards are ordered from most important error through best correct + my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ; + + my $best = $max; + my $j=0; + my $which; + foreach my $award (@$awardref) { + if ($awards->{$award} < $best) { + $best = $awards->{$award}; + $which = $j; + } + $j++; + } + if (defined($which)) { + if (ref($nameref)) { + return ($$awardref[$which],$$msgref[$which],$$nameref[$which]); + } else { + return ($$awardref[$which],$$msgref[$which]); + } } return ('ERROR',undef); } +} sub decideoutput { my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_; @@ -408,16 +589,25 @@ sub decideoutput { my $bgcolor='orange'; my $added_computer_text=0; my %possiblecolors = - ( 'correct' => '#aaffaa', - 'charged_try' => '#ffaaaa', + ( 'correct' => '#aaffaa', + 'charged_try' => '#ffaaaa', 'not_charged_try' => '#ffffaa', - 'no_message' => '#fffff', + 'no_grade' => '#ffffaa', + 'no_message' => '#ffffff', ); + my $part = $Apache::inputtags::part; + my $handgrade = + ('yes' eq lc(&Apache::lonnet::EXT("resource.$part.handgrade"))); + + my $computer = ($handgrade)? '' + : " ".&mt("Computer's answer now shown above."); + &Apache::lonxml::debug("handgrade has :$handgrade:"); + if ($previous) { $previousmsg=&mt('You have entered that answer before'); } - if ($solved =~ /^correct/) { - $bgcolor=$possiblecolors{'correct'}; + if ($solved =~ /^correct/) { + $bgcolor=$possiblecolors{'correct'}; $message=&mt('You are correct.'); if ($awarded < 1 && $awarded > 0) { $message=&mt('You are partially correct.'); @@ -426,22 +616,23 @@ sub decideoutput { $message=&mt('Incorrect.'); $bgcolor=$possiblecolors{'charged_try'}; } - - if ($target eq 'tex') { - $message = '\textbf{'.$message.'}'; - } else { - $message = "".$message.""; - } - $added_computer_text=1; - - if ($env{'request.filename'} !~ + if ($env{'request.filename'} =~ m|/res/lib/templates/examupload.problem$|) { - if ($target ne 'tex') { - $message.=" ".&mt("Computer's answer now shown above."); + $message = &mt("A score has been assigned."); + $added_computer_text=1; + } else { + if ($target eq 'tex') { + $message = '\textbf{'.$message.'}'; + } else { + $message = "".$message.""; + $message.= $computer; } - unless ($env{'course.'. + $added_computer_text=1; + my ($symb) = &Apache::lonnet::whichuser(); + if ((!$env{'course.'. $env{'request.course.id'}. - '.disable_receipt_display'} eq 'yes') { + '.disable_receipt_display'} eq 'yes')&& + $symb) { $message.=(($target eq 'web')?'
':' '). &mt('Your receipt is').' '.&Apache::lonnet::receipt($Apache::inputtags::part). (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):''); @@ -468,7 +659,7 @@ sub decideoutput { $message = '\textbf{'.&mt('You are correct.').'}'; } else { $message = "".&mt('You are correct.').""; - $message.=" ".&mt("Computer's answer now shown above."); + $message.= $computer; } $added_computer_text=1; unless ($env{'course.'. @@ -486,6 +677,10 @@ sub decideoutput { $message = ''; $bgcolor=$possiblecolors{'no_feedback'}; $button=1; + } elsif ($award eq 'EXTRA_ANSWER') { + $message = &mt('Some extra items were submitted.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button = 1; } elsif ($award eq 'MISSING_ANSWER') { $message = &mt('Some items were not submitted.'); $bgcolor=$possiblecolors{'not_charged_try'}; @@ -515,10 +710,8 @@ sub decideoutput { $button=1; } elsif ($award eq 'SIG_FAIL') { my ($used,$min,$max)=split(':',$awardmsg); - my $word; - if ($used < $min) { $word=&mt('more'); } - if ($used > $max) { $word=&mt('fewer'); } - $message = &mt("Submission not graded. Use [_2] digits.",$used,$word); + my $word = ($used < $min) ? 'more' : 'fewer'; + $message = &mt("Submission not graded. Use $word digits.",$used); $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'UNIT_INVALID_INSTRUCTOR') { @@ -559,7 +752,7 @@ sub decideoutput { $button=1; } elsif ($award eq 'SUBMITTED') { $message = &mt("Your submission has been recorded."); - $bgcolor=$possiblecolors{'correct'}; + $bgcolor=$possiblecolors{'no_grade'}; $button=1; } elsif ($award eq 'DRAFT') { $message = &mt("A draft copy has been saved."); @@ -570,21 +763,40 @@ sub decideoutput { $bgcolor=$possiblecolors{'correct'}; $button=0; } elsif ($award eq '') { - $bgcolor=$possiblecolors{'not_charged_try'}; + if ($handgrade && $Apache::inputtags::status[-1] eq 'SHOW_ANSWER') { + $message = &mt("Nothing submitted."); + $bgcolor=$possiblecolors{'charged_try'}; + } else { + $bgcolor=$possiblecolors{'not_charged_try'}; + } $button=1; } else { $message = &mt("Unknown message").": $award"; $button=1; } + my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser(); + foreach my $resid(@Apache::inputtags::response){ + if ($Apache::lonhomework::history{"resource.$part.$resid.handback"}) { + $message.='
'; + my @files = split(/\s*,\s*/, + $Apache::lonhomework::history{"resource.$part.$resid.handback"}); + my $file_msg; + foreach my $file (@files) { + $file_msg.= '
'.$file.''; + } + $message .= &mt('Returned file(s): [_1]',$file_msg); + } + } + 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'}; + $bgcolor=$possiblecolors{'no_grade'}; $button=1; } if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && !$added_computer_text && $target ne 'tex') { - $message.=" ".&mt("Computer's answer now shown above."); + $message.= $computer; $added_computer_text=1; } return ($button,$bgcolor,$message,$previousmsg); @@ -740,6 +952,45 @@ sub setgradedata { return ''; } $Apache::lonhomework::results{"resource.$id.award"} = $award; + if ($award eq 'SUBMITTED') { + &Apache::response::add_to_gradingqueue(); + } +} + +sub find_which_previous { + my ($version) = @_; + my $part = $Apache::inputtags::part; + my (@previous_version); + foreach my $resp (@Apache::inputtags::response) { + my $key = "$version:resource.$part.$resp.submission"; + my $submission = $Apache::lonhomework::history{$key}; + my %previous = &Apache::response::check_for_previous($submission, + $part,$resp, + $version); + push(@previous_version,$previous{'version'}); + } + return &previous_match(\@previous_version, + scalar(@Apache::inputtags::response)); +} + +sub previous_match { + my ($previous_array,$count) = @_; + my $match = 0; + my @matches; + foreach my $versionar (@$previous_array) { + foreach my $version (@$versionar) { + $matches[$version]++; + } + } + my $which=0; + foreach my $elem (@matches) { + if ($elem eq $count) { + $match=1; + last; + } + $which++; + } + return ($match,$which); } sub grade { @@ -760,14 +1011,10 @@ sub grade { 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;}} + my ($match) = + &previous_match(\@Apache::inputtags::previous_version, + scalar(@Apache::inputtags::response)); + if ($match) { $previously_used = 'PREVIOUSLY_LAST'; foreach my $value (@Apache::inputtags::previous) { @@ -784,10 +1031,82 @@ sub grade { return ''; } +sub get_grade_messages { + my ($id,$prefix,$target,$status) = @_; + + my ($message,$latemessage,$trystr,$previousmsg); + my $showbutton = 1; + + my $award = $Apache::lonhomework::history{"$prefix.award"}; + my $awarded = $Apache::lonhomework::history{"$prefix.awarded"}; + my $solved = $Apache::lonhomework::history{"$prefix.solved"}; + my $previous = $Apache::lonhomework::history{"$prefix.previous"}; + my $awardmsg = $Apache::lonhomework::history{"$prefix.awardmsg"}; + &Apache::lonxml::debug("Found Award |$award|$solved|$awardmsg"); + if ( $award ne '' || $solved ne '' || $status eq 'SHOW_ANSWER') { + &Apache::lonxml::debug('Getting message'); + ($showbutton,my $bgcolor,$message,$previousmsg) = + &decideoutput($award,$awarded,$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{"$prefix.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' || + $Apache::lonhomework::parsing_a_task) { + $tries_text=&mt('Submissions'); + } + + if ($showbutton) { + if ($target eq 'tex') { + if ($env{'request.state'} ne "construct" + && $Apache::lonhomework::type ne 'exam' + && $env{'form.suppress_tries'} ne 'yes') { + $trystr = ' {\vskip 1 mm \small \textit{'.$tries_text.'} '. + $tries.'/'.$maxtries.'} \vskip 2 mm '; + } else { + $trystr = '\vskip 0 mm '; + } + } else { + $trystr = "".$tries_text." $tries"; + if ($Apache::lonhomework::parsing_a_task) { + } elsif($env{'request.state'} ne 'construct') { + $trystr.="/$maxtries"; + } else { + if (defined($Apache::inputtags::params{'maxtries'})) { + $trystr.="/".$Apache::inputtags::params{'maxtries'}; + } + } + $trystr.=""; + } + } + if ($Apache::lonhomework::history{"$prefix.afterduedate"}) { + #last submissions was after due date + $latemessage=&mt(' The last submission was after the Due Date ');; + if ($target eq 'web') { + $latemessage=''.$latemessage.''; + } + } + return ($previousmsg,$latemessage,$message,$trystr,$showbutton); +} + sub gradestatus { my ($id,$target) = @_; my $showbutton = 1; - my $bgcolor = ''; my $message = ''; my $latemessage = ''; my $trystr=''; @@ -796,74 +1115,27 @@ sub gradestatus { 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 $awarded = $Apache::lonhomework::history{"resource.$id.awarded"}; - 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 '' || $status eq 'SHOW_ANSWER') { - &Apache::lonxml::debug('Getting message'); - ($showbutton,$bgcolor,$message,$previousmsg) = - &decideoutput($award,$awarded,$awardmsg,$solved,$previous, - $target); - if ($target eq 'tex') { - $message='\vskip 2 mm '.$message.' '; - } else { - $message="$message"; - if ($previousmsg) { - $previousmsg="$previousmsg"; - } - } + if ( $status ne 'CLOSED' + && $status ne 'UNAVAILABLE' + && $status ne 'INVALID_ACCESS' + && $status ne 'NEEDS_CHECKIN' + && $status ne 'NOT_IN_A_SLOT') { + + ($previousmsg,$latemessage,$message,$trystr) = + &get_grade_messages($id,"resource.$id",$target,$status, + $showbutton); + if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') { + $showbutton = 0; } - 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' || - $Apache::lonhomework::parsing_a_task) { - $tries_text=&mt('Submissions'); + if ( $status eq 'SHOW_ANSWER') { + undef($previousmsg); } - if ( $showbutton ) { - if ($target eq 'tex') { - if ($env{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam' && $env{'form.suppress_tries'} ne 'yes') { - $trystr = ' {\vskip 1 mm \small \textit{'.$tries_text.'} '.$tries.'/'.$maxtries.'} \vskip 2 mm '; - } else { - $trystr = '\vskip 0 mm '; - } - } else { - $trystr = "".$tries_text." $tries"; - if ($Apache::lonhomework::parsing_a_task) { - } elsif($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 - $latemessage=&mt(' The last submission was after the Due Date ');; - if ($target eq 'web') { - $latemessage=''.$latemessage.''; + $button = ''; } } + } my $output= $previousmsg.$latemessage.$message.$trystr; if ($output =~ /^\s*$/) { @@ -872,10 +1144,95 @@ sub gradestatus { if ($target eq 'tex') { return $button.' \vskip 0 mm '.$output.' '; } else { - return ''.$output.'
'.$button.'
'; + return ''.$output.'
'.$button.''.&previous_tries($id,$target).'
'; + } + } +} + +sub previous_tries { + my ($id,$target) = @_; + my $output; + my $status = $Apache::inputtags::status['-1']; + + my $count; + my %count_lookup; + + foreach my $i (1..$Apache::lonhomework::history{'version'}) { + my $prefix = $i.":resource.$id"; + + next if (!exists($Apache::lonhomework::history{"$prefix.award"})); + $count++; + $count_lookup{$i} = $count; + + my ($previousmsg,$latemessage,$message,$trystr); + + ($previousmsg,$latemessage,$message,$trystr) = + &get_grade_messages($id,"$prefix",$target,$status); + if (!exists($Apache::lonhomework::history{"$prefix.tries"})) { + undef($trystr); + } + + if ($previousmsg ne '') { + my ($match,$which) = &find_which_previous($i); + $message=$previousmsg; + my $previous = $count_lookup{$which}; + $message =~ s{()}{ as submission $previous $1}; + + } elsif ($trystr ne '') { + ($trystr) = ($trystr =~ m{(\d+)/\d+}); + $message =~ s{()}{$1 $trystr }; } + + + $output.=''; + $output.=''.$count.''; + $output.=$message; + + foreach my $resid (@Apache::inputtags::response) { + my $prefix = $prefix.".$resid"; + if (exists($Apache::lonhomework::history{"$prefix.submission"})) { + my $submission = + $Apache::inputtags::submission_display{"$prefix.submission"}; + if (!defined($submission)) { + $submission = + $Apache::lonhomework::history{"$prefix.submission"}; + } + $output.=''.$submission.''; + } else { + $output.=''; + } + } + $output.=''."\n"; } + return if ($output eq ''); + my $headers = + ''.''.&mt('Submission #').''.&mt('Try'). + ''. + &mt('Submitted Answer').''; + $output =''.$headers.$output.'
'; + #return $output; + $output=~s/\\/\\\\/g; + $output=~s/\'/\\\'/g; + $output=~s/\s+/ /g; + my $windowopen=&Apache::lonhtmlcommon::javascript_docopen(); + my $start_page = + &Apache::loncommon::start_page('Previous Tries', undef, + {'only_body' => 1, + 'bgcolor' => '#FFFFFF', + 'js_ready' => 1,}); + my $end_page = + &Apache::loncommon::end_page({'js_ready' => 1,}); + + my $result ="".&mt("Previous Tries")."
"; + #use Data::Dumper; + #&Apache::lonnet::logthis(&Dumper(\%Apache::inputtags::submission_display)); + return $result; } + 1; __END__ 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.