--- loncom/homework/inputtags.pm 2005/11/03 11:11:25 1.177 +++ loncom/homework/inputtags.pm 2006/11/01 23:24:52 1.210 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # input definitons # -# $Id: inputtags.pm,v 1.177 2005/11/03 11:11:25 foxr Exp $ +# $Id: inputtags.pm,v 1.210 2006/11/01 23:24:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,41 +31,46 @@ 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. -# (I like this way of documenting variables better since -# you don't have to rake your eyes over as much code rf). -# -# @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::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 { @Apache::inputtags::input=(); @Apache::inputtags::inputlist=(); @@ -129,15 +134,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); @@ -147,23 +152,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; } } - 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=''; @@ -240,17 +310,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.= ''; } + 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') { @@ -267,10 +347,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; } @@ -279,6 +365,7 @@ 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 ""; } @@ -300,6 +387,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; } @@ -336,19 +429,7 @@ 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"}; - &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)'); - } + $result .= &show_past_file_submission($part,$id); } if ( $which eq 'both') { $result.='
'.''.&mt('OR:').'
'; @@ -358,41 +439,101 @@ sub file_selector { &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 $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(undef,undef); + 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++; @@ -400,21 +541,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)=@_; @@ -424,16 +575,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.'); @@ -451,7 +611,7 @@ sub decideoutput { $message = '\textbf{'.$message.'}'; } else { $message = "".$message.""; - $message.=" ".&mt("Computer's answer now shown above."); + $message.= $computer; } $added_computer_text=1; unless ($env{'course.'. @@ -483,7 +643,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.'. @@ -501,6 +661,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'}; @@ -574,7 +738,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."); @@ -585,21 +749,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); @@ -755,6 +938,9 @@ sub setgradedata { return ''; } $Apache::lonhomework::results{"resource.$id.award"} = $award; + if ($award eq 'SUBMITTED') { + &Apache::response::add_to_gradingqueue(); + } } sub grade { @@ -811,8 +997,11 @@ 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') { + if ( $status ne 'CLOSED' + && $status ne 'UNAVAILABLE' + && $status ne 'INVALID_ACCESS' + && $status ne 'NEEDS_CHECKIN' + && $status ne 'NOT_IN_A_SLOT') { my $award = $Apache::lonhomework::history{"resource.$id.award"}; my $awarded = $Apache::lonhomework::history{"resource.$id.awarded"}; my $solved = $Apache::lonhomework::history{"resource.$id.solved"};