--- loncom/homework/inputtags.pm 2001/07/13 14:02:35 1.38 +++ loncom/homework/inputtags.pm 2005/11/03 17:44:15 1.178 @@ -1,302 +1,897 @@ # The LearningOnline Network with CAPA # input definitons -# 2/19 Guy +# +# $Id: inputtags.pm,v 1.178 2005/11/03 17:44:15 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; - -sub BEGIN { - &Apache::lonxml::register('Apache::inputtags',('textarea','textline','datasubmission')); -} - +use Apache::loncommon; +use Apache::lonlocal; +use Apache::lonnet; + +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. sub initialize_inputtags { - # list of current input ids - @Apache::inputtags::input=(); - # list of all input ids seen in this problem - @Apache::inputtags::inputlist=(); - # list of all current response ids - @Apache::inputtags::response=(); - #list of all response ids seen in this problem - @Apache::inputtags::responselist=(); - # id of current part, 0 means that no part is current (inside 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=(); + @Apache::inputtags::input=(); + @Apache::inputtags::inputlist=(); + @Apache::inputtags::response=(); + @Apache::inputtags::responselist=(); + @Apache::inputtags::hint=(); + @Apache::inputtags::hintlist=(); + @Apache::inputtags::previous=(); + @Apache::inputtags::previous_version=(); + $Apache::inputtags::part=''; + @Apache::inputtags::partlist=(); + @Apache::inputtags::status=(); + %Apache::inputtags::params=(); + @Apache::inputtags::import=(); + @Apache::inputtags::importlist=(); + $Apache::inputtags::response_with_no_part=0; + %Apache::inputtags::answertxt=(); +} + +sub check_for_duplicate_ids { + my %check; + foreach my $id (@Apache::inputtags::partlist, + @Apache::inputtags::responselist, + @Apache::inputtags::hintlist, + @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 $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; } sub end_input { - pop @Apache::inputtags::input; - return ''; + pop @Apache::inputtags::input; + return ''; } -sub start_textarea { - my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; - my $result = ""; - my $id = &start_input($parstack,$safeeval); - if ($target eq 'web') { - my $oldresponse = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.$Apache::inputtags::response['-1'].submission"}; - my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval); - if ( $cols eq '') { $cols = 80; } - my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval); - if ( $rows eq '') { $rows = 10; } - $result= '"; - } - &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 = 16; } + my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval); + $result=''; + if ($addchars) { + $result.=&addchars('HWVAL_'.$resid,$addchars); + } + push @Apache::lonxml::htmlareafields,'HWVAL_'.$resid; + $result.= '"; + } + } elsif ($target eq 'edit') { + $result=&Apache::edit::end_table(); + } + &end_input; + return $result; } 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') { + $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); + } + my $readonly=&Apache::lonxml::get_param('readonly',$parstack, + $safeeval); + if (lc($readonly) eq 'yes') { + $readonly=' readonly="readonly" '; + } else { + $readonly=''; + } + $result.= ''; + } + } else { + #right or wrong don't show what was last typed in. + $result=''.$Apache::inputtags::answertxt{$id}.''; + #$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::select_arg('Readonly:','readonly', + ['no','yes'],$token); + $result.=&Apache::edit::end_row(); + $result.=&Apache::edit::end_table(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'size', + 'addchars','readonly'); + 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,$tagstack,$parstack,$parser,$safeeval)=@_; - if ($target eq 'edit') { return ('','no'); } - 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; } -sub start_datasubmission { - 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 ""; +} + +# $part -> partid +# $id -> responseid +# $uploadefiletypes -> comma seperated list of extensions allowed or * for any +# $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,$extratext)=@_; + if (!$uploadedfiletypes) { return ''; } + + my $jspart=$part; + $jspart=~s/\./_/g; + + my $result; + + $result.=''; + if ($uploadedfiletypes ne '*') { + $result.= + &mt('Allowed filetypes: [_1]',$uploadedfiletypes).'
'; + } + if ($which eq 'uploadonly' || $which eq 'both') { + $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"}; + &Apache::lonxml::extlink($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)'); + } + } + if ( $which eq 'both') { + $result.='
'.''.&mt('OR:').'
'; + } + if ($which eq 'portfolioonly' || $which eq 'both') { + $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.=''; + return $result; } -sub end_datasubmission { - my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; - if ( $target == 'web' ) { - return ''; - } - 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 '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 ($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','COMMA_FAIL') { + ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref); + if (defined($result)) { return ($result,$msg); } + } + return ('ERROR',undef); } sub decideoutput { - my ($award,$solved)=@_; - my $message=''; - my $button=0; - if ($solved =~ /^correct/) { - $message = "You are correct. Your receipt is ". - &Apache::lonnet::receipt; - $button=0; - } elsif ($solved =~ /^excused/) { - $message = "You are excused from the problem."; - $button=0; - } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { - if ($solved =~ /^incorrect/ || $solved eq '') { - $message = "Incorrect"; - $button=1; + my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_; + my $message=''; + my $button=0; + my $previousmsg; + my $bgcolor='orange'; + my $added_computer_text=0; + 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/) { + $bgcolor=$possiblecolors{'correct'}; + $message=&mt('You are correct.'); + if ($awarded < 1 && $awarded > 0) { + $message=&mt('You are partially correct.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + } elsif ($awarded < 1) { + $message=&mt('Incorrect.'); + $bgcolor=$possiblecolors{'charged_try'}; + } + if ($env{'request.filename'} =~ + m|/res/lib/templates/examupload.problem$|) { + $message = &mt("A score has been assigned."); + $added_computer_text=1; + } else { + if ($target eq 'tex') { + $message = '\textbf{'.$message.'}'; + } else { + $message = "".$message.""; + $message.=" ".&mt("Computer's answer now shown above."); + } + $added_computer_text=1; + 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'):''); + } + } + $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 { + if ($target eq 'tex') { + $message = '\textbf{'.&mt('You are correct.').'}'; + } else { + $message = "".&mt('You are correct.').""; + $message.=" ".&mt("Computer's answer now shown above."); + } + $added_computer_text=1; + 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('Submission won\'t be graded. The type of file submitted is not allowed.'); + $bgcolor=$possiblecolors{'not_charged_try'}; + $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); + $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]".',&markup_unit($awardmsg,$target)); + 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('Incompatible units. No conversion found between "[_1]" and the required units.',&markup_unit($awardmsg,$target)); + 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]".',&markup_unit($awardmsg,$target)); + $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 'COMMA_FAIL') { + $message = &mt("Proper comma separation is required").'.'; + $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 = &mt("A draft copy has been saved."); + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; + } elsif ($award eq 'ASSIGNED_SCORE') { + $message = &mt("A score has been assigned."); + $bgcolor=$possiblecolors{'correct'}; + $button=0; + } elsif ($award eq '') { + $bgcolor=$possiblecolors{'not_charged_try'}; + $button=1; } else { - $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; - } elsif ($award eq 'SUBMITTED') { - $message = "Your submission has been recorded."; - $button=1; - } else { - $message = "Unknown message: $award"; - $button=1; - } - return ($button,$message); + $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; + } + if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && + !$added_computer_text && $target ne 'tex') { + $message.=" ".&mt("Computer's answer now shown above."); + $added_computer_text=1; + } + return ($button,$bgcolor,$message,$previousmsg); +} + +sub markup_unit { + my ($unit,$target)=@_; + if ($target eq 'tex') { + return '\texttt{'.&Apache::lonxml::latex_special_symbols($unit).'}'; + } else { + return "".$unit.""; + } +} + +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 hidealldata { + my ($id)=@_; + foreach my $key (keys(%Apache::lonhomework::results)) { + if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) { + &Apache::lonxml::debug("Hidding $key"); + my $newkey=$key; + $newkey=~s/^(resource\.\Q$id\E\.[^\.]+\.)(.*)$/${1}hidden${2}/; + $Apache::lonhomework::results{$newkey}= + $Apache::lonhomework::results{$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'; - } elsif ( $award eq 'SUBMITTED' ) { - $Apache::lonhomework::results{"resource.$id.tries"} = - $Apache::lonhomework::history{"resource.$id.tries"} + 1; - $Apache::lonhomework::results{"resource.$id.solved"} = - 'ungraded_attempted'; - } else { - $Apache::lonhomework::results{"resource.$id.solved"} = - 'incorrect_attempted'; - } - $Apache::lonhomework::results{"resource.$id.award"} = $award; + my ($award,$msg,$id,$previously_used) = @_; + if ($Apache::lonhomework::scantronmode && + &Apache::lonnet::validCODE($env{'form.CODE'})) { + $Apache::lonhomework::results{"resource.CODE"}=$env{'form.CODE'}; + } elsif ($Apache::lonhomework::scantronmode && + $env{'form.CODE'} eq '' && + $Apache::lonhomework::history{"resource.CODE"} ne '') { + $Apache::lonhomework::results{"resource.CODE"}=''; + } + + 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') { + # the student doesn't already have it correct, + # or we are in a mode (scantron orno problem status) where a correct + # can become incorrect + # 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::scantronmode) { + $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::scantronmode) { + $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.submitted'}) { - my @awards = (); - &Apache::lonxml::debug("$#Apache::inputtags::responselist"); - foreach $response (@Apache::inputtags::responselist) { - &Apache::lonxml::debug("looking for response.$id.$response.awarddetail"); - my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"}; - if ( $value ne '' ) { - &Apache::lonxml::debug("keeping $value from $response for $id"); - push (@awards,$value); - } else { - &Apache::lonxml::debug("skipping $value from $response for $id"); - } - } - my $finalaward = &finalizeawards(@awards); - &Apache::lonxml::debug("final award $finalaward"); - &setgradedata($finalaward,$id); + 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,$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 ''; + return ''; } sub gradestatus { - my ($id) = @_; - my $showbutton = 1; - my $message = ''; - my $trystr=''; - my $button=''; - - my $status = $Apache::inputtags::status['-1']; - &Apache::lonxml::debug("gradestatus has :$status:"); - if ( $status ne 'CLOSED' ) { - my $award = $Apache::lonhomework::history{"resource.$id.award"}; - my $solved = $Apache::lonhomework::history{"resource.$id.solved"}; - &Apache::lonxml::debug("Found Award |$award|$solved|"); - if ( $award ne '' ) { - &Apache::lonxml::debug('Getting message'); - ($showbutton,$message) = &decideoutput($award,$solved); - $message="
$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,$target) = @_; + my $showbutton = 1; + my $bgcolor = ''; + my $message = ''; + my $latemessage = ''; + my $trystr=''; + my $button=''; + my $previousmsg=''; + + 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"; + } + } + } + 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 ( $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.''; + } + } + } + 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__