File:  [LON-CAPA] / loncom / homework / inputtags.pm
Revision 1.334: download - view: text, annotated - select for diffs
Tue Apr 21 12:28:05 2015 UTC (9 years, 1 month ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Bug 2802
  If at least one response item in a problem part is set to lenient, then
  if the award for that item is ASSIGNED_SCORE, that should trump award(s)
  of INCORRECT for other response items in the same problem part, when
  finalizing the award, so "You are partially correct" will be shown,
  unless feedback is suppressed.

    1: # The LearningOnline Network with CAPA
    2: # input  definitons
    3: #
    4: # $Id: inputtags.pm,v 1.334 2015/04/21 12:28:05 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: 
   28: =pod
   29: 
   30: =head1 NAME
   31: 
   32: Apache::inputtags
   33: 
   34: =head1 SYNOPSIS
   35: 
   36: 
   37: 
   38: This is part of the LearningOnline Network with CAPA project
   39: described at http://www.lon-capa.org.
   40: 
   41: 
   42: =head1 NOTABLE SUBROUTINES
   43: 
   44: =over
   45: 
   46: =item 
   47: 
   48: =back
   49: 
   50: =cut
   51: 
   52: package Apache::inputtags;
   53: use HTML::Entities();
   54: use strict;
   55: use Apache::loncommon;
   56: use Apache::lonhtmlcommon;
   57: use Apache::lonlocal;
   58: use Apache::lonnet;
   59: use LONCAPA;
   60:  
   61: 
   62: BEGIN {
   63:     &Apache::lonxml::register('Apache::inputtags',('hiddensubmission','hiddenline','textfield','textline'));
   64: }
   65: 
   66: =pod
   67: 
   68: =item initialize_inputtags()
   69: 
   70: Initializes a set of global variables used during the parse of the problem.
   71: 
   72: @Apache::inputtags::input        - List of current input ids.
   73: @Apache::inputtags::inputlist    - List of all input ids seen this problem.
   74: @Apache::inputtags::response     - List of all current resopnse ids.
   75: @Apache::inputtags::responselist - List of all response ids seen this 
   76:                                      problem.
   77: @Apache::inputtags::hint         - List of all hint ids.
   78: @Apache::inputtags::hintlist     - List of all hint ids seen this problem.
   79: @Apache::inputtags::previous     - List describing if specific responseds
   80:                                      have been used
   81: @Apache::inputtags::previous_version - Submission responses were used in.
   82: $Apache::inputtags::part         - Current part id (valid only in 
   83:                                      <problem>)
   84:                                    0 if not in a part.
   85: @Apache::inputtags::partlist     - List of part ids seen in the current
   86:                                      <problem>
   87: @Apache::inputtags::status       - List of problem  statuses. First 
   88:                                    element is the status of the <problem>
   89:                                    the remainder are for individual <part>s.
   90: %Apache::inputtags::params       - Hash of defined parameters for the
   91:                                    current response.
   92: @Apache::inputtags::import       - List of all ids for <import> thes get
   93:                                    join()ed and prepended.
   94: @Apache::inputtags::importlist   - List of all import ids seen.
   95: $Apache::inputtags::response_with_no_part
   96:                                  - Flag set true if we have seen a response
   97:                                    that is not inside a <part>
   98: %Apache::inputtags::answertxt    - <*response> tags store correct
   99:                                    answer strings for display by <textline/>
  100:                                    in this hash.
  101: %Apache::inputtags::submission_display
  102:                                  - <*response> tags store improved display
  103:                                    of submission strings for display by part
  104:                                    end.
  105: 
  106: =cut
  107: 
  108: sub initialize_inputtags {
  109:     @Apache::inputtags::input=();
  110:     @Apache::inputtags::inputlist=();
  111:     @Apache::inputtags::response=();
  112:     @Apache::inputtags::responselist=();
  113:     @Apache::inputtags::hint=();
  114:     @Apache::inputtags::hintlist=();
  115:     @Apache::inputtags::previous=();
  116:     @Apache::inputtags::previous_version=();
  117:     $Apache::inputtags::part='';
  118:     @Apache::inputtags::partlist=();
  119:     @Apache::inputtags::status=();
  120:     %Apache::inputtags::params=();
  121:     @Apache::inputtags::import=();
  122:     @Apache::inputtags::importlist=();
  123:     $Apache::inputtags::response_with_no_part=0;
  124:     %Apache::inputtags::answertxt=();
  125:     %Apache::inputtags::submission_display=();
  126: }
  127: 
  128: #
  129: #  provides the onblur binding for spellchecking.  This could be an
  130: #  empty string if spellchecking was not enabled.
  131: #  Jquery selector binding is done rather than setting an onblur
  132: #  attribute because we'll need to set the element's spellcheck language
  133: #  option dynamically so we need $(this) to be defined.
  134: #
  135: # @param id   - The element id to bind.
  136: # @param lang - Language in which spellchecking is desired.
  137: #               if undef, nothing is generated.  
  138: # @return string - onblur specification to do the requested spellchecking.
  139: #
  140: sub spellcheck_onblur {
  141:     my ($id, $lang) = @_;
  142:     my $result = '';
  143:     if ($lang) {
  144: 
  145: 	$result = <<JAVASCRIPT;
  146: <script type="text/javascript">
  147: \$('\#$id').blur(function() {
  148:     doSpellcheck('\#$id', '$lang');
  149:  });
  150: </script>
  151: 
  152: JAVASCRIPT
  153: 
  154: 
  155:     }
  156:     return $result;
  157: }
  158: 
  159: sub check_for_duplicate_ids {
  160:     my %check;
  161:     foreach my $id (@Apache::inputtags::partlist,
  162: 		    @Apache::inputtags::responselist,
  163: 		    @Apache::inputtags::hintlist,
  164: 		    @Apache::inputtags::importlist) {
  165: 	$check{$id}++;
  166:     }
  167:     my @duplicates;
  168:     foreach my $id (sort(keys(%check))) {
  169: 	if ($check{$id} > 1) {
  170: 	    push(@duplicates,$id);
  171: 	}
  172:     }
  173:     if (@duplicates) {
  174: 	&Apache::lonxml::error("Duplicated ids found, problem will operate incorrectly. Duplicated ids seen: ",join(', ',@duplicates));
  175:     }
  176: }
  177: 
  178: sub start_input {
  179:     my ($parstack,$safeeval)=@_;
  180:     my $id = &Apache::lonxml::get_id($parstack,$safeeval);
  181:     push (@Apache::inputtags::input,$id);
  182:     push (@Apache::inputtags::inputlist,$id);
  183:     return $id;
  184: }
  185: 
  186: sub end_input {
  187:     pop @Apache::inputtags::input;
  188:     return '';
  189: }
  190: 
  191: sub addchars {
  192:     my ($fieldid,$addchars)=@_;
  193:     my $output='';
  194:     foreach (split(/\,/,$addchars)) {
  195: 	$output.='<a href="javascript:void(document.forms.lonhomework.'.
  196: 	    $fieldid.'.value+=\''.$_.'\')">'.$_.'</a> ';
  197:     }
  198:     return $output;
  199: }
  200: 
  201: sub start_textfield {
  202:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  203:     my $result = "";
  204:     my $id = &start_input($parstack,$safeeval);
  205:     my $resid=$Apache::inputtags::response[-1];
  206:     if ($target eq 'web') {
  207: 	$Apache::lonxml::evaluate--;
  208: 	my $partid=$Apache::inputtags::part;
  209:         my ($oldresponse,$newvariation);
  210:         if ((($Apache::lonhomework::history{"resource.$partid.type"} eq 'randomizetry') ||
  211:              ($Apache::lonhomework::type eq 'randomizetry')) &&
  212:              ($Apache::inputtags::status[-1] eq 'CAN_ANSWER')) {
  213:             if ($env{'form.'.$partid.'.rndseed'} ne
  214:                 $Apache::lonhomework::history{"resource.$partid.rndseed"}) {
  215:                 $newvariation = 1;
  216:             }
  217:         }
  218:         unless ($newvariation) {
  219:             if ((($env{'form.grade_username'} eq '') && ($env{'form.grade_domain'} eq '')) ||
  220:                 (($env{'form.grade_username'} eq $env{'user.name'}) &&
  221:                  ($env{'form.grade_domain'} eq $env{'user.domain'}))) {
  222:                 $oldresponse = $Apache::lonhomework::history{"resource.$partid.$resid.submission"};
  223:             } elsif (($Apache::lonhomework::history{"resource.$partid.type"} eq 'anonsurvey') ||
  224:                     ($Apache::lonhomework::history{"resource.$partid.type"} eq 'anonsurveycred')) {
  225:                 $oldresponse = '* '.&mt('(only shown to submitter)').' *';
  226:             } else {
  227:                 $oldresponse = $Apache::lonhomework::history{"resource.$partid.$resid.submission"};
  228:             }
  229:         }
  230: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  231: 	    my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
  232: 	    if ( $cols eq '') { $cols = 80; }
  233: 	    my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
  234: 	    if ( $rows eq '') { $rows = 16; }
  235: 	    my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
  236: 	    $result='';
  237: 	    my $tagident = 'HWVAL_' . $resid;
  238:             my $itemid = 'HWVAL_'.$partid.'_'.$resid;
  239: 	    if ($addchars) {
  240: 		$result.=&addchars($tagident, $addchars);
  241: 	    }
  242:             my $textareaclass;
  243:             unless (&Apache::londefdef::is_inside_of($tagstack,
  244:                                                     'externalresponse')) {
  245:                 $textareaclass = 'class="LC_richDetectHtml spellchecked"';
  246:             }
  247: 	    $result.= '<textarea wrap="hard" name="'.$tagident.'" id="'.$itemid.'" ' .
  248: 		      'rows="'.$rows.'" cols="'.$cols.'" '.$textareaclass
  249: 		      .'>'.
  250:                       &HTML::Entities::encode($oldresponse,'<>&"');
  251: 	    if ($oldresponse ne '') {
  252: 
  253: 		#get rid of any startup text if the user has already responded
  254: 		&Apache::lonxml::get_all_text("/textfield",$parser,$style);
  255: 	    }
  256: 	} else {
  257: 	    #show past answer in the essayresponse case
  258: 	    if ($oldresponse =~ /\S/
  259: 		&& &Apache::londefdef::is_inside_of($tagstack,
  260: 						    'essayresponse') ) {
  261: 		$result='<table class="LC_pastsubmission"><tr><td>'.
  262: 		    &HTML::Entities::encode($oldresponse,'"<>&').
  263:                     '</td></tr></table>';
  264: 	    }
  265: 	    #get rid of any startup text
  266: 	    &Apache::lonxml::get_all_text("/textfield",$parser,$style);
  267: 	}
  268:     } elsif ($target eq 'grade') {
  269: 	my $seedtext=&Apache::lonxml::get_all_text("/textfield",$parser,
  270: 						   $style);
  271: 	if ($seedtext eq $env{'form.HWVAL_'.$resid}) {
  272: 	    # if the seed text is still there it wasn't a real submission
  273: 	    $env{'form.HWVAL_'.$resid}='';
  274: 	}
  275:     } elsif ($target eq 'edit') {
  276: 	$result.=&Apache::edit::tag_start($target,$token);
  277: 	$result.=&Apache::edit::text_arg('Rows:','rows',$token,4);
  278: 	$result.=&Apache::edit::text_arg('Columns:','cols',$token,4);
  279: 	$result.=&Apache::edit::text_arg
  280: 	    ('Click-On Texts (comma sep):','addchars',$token,10);
  281: 	my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser,
  282: 						   $style);
  283: 	$result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);
  284:         my $spell_langs = &spelling_languages();
  285: 	$result .= &Apache::edit::select_arg('Spellcheck for:', 'spellcheck',
  286: 					     $spell_langs, $token);
  287:     } elsif ($target eq 'modified') {
  288: 	my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  289: 						     $safeeval,'rows','cols',
  290: 						     'addchars', 'spellcheck');
  291: 	if ($constructtag) {
  292: 	    $result = &Apache::edit::rebuild_tag($token);
  293: 	} else {
  294: 	    $result=$token->[4];
  295: 	}
  296: 	$result.=&Apache::edit::modifiedfield("/textfield",$parser);
  297:     } elsif ($target eq 'tex') {
  298: 	my $number_of_lines = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
  299: 	my $width_of_box = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
  300: 	if ($$tagstack[-2] eq 'essayresponse' and $Apache::lonhomework::type eq 'exam') {
  301: 	    $result = '\fbox{\fbox{\parbox{\textwidth-5mm}{';
  302: 	    for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
  303: 	    $result.='\strut \\\\\strut \\\\\strut \\\\\strut \\\\}}}';
  304: 	} else {
  305:             if ($env{'form.pdfFormFields'} eq 'yes') {
  306:                 my $fieldname = $env{'request.symb'}.
  307:                                 '&part_'. $Apache::inputtags::part.
  308:                                 '&textresponse'.
  309:                                 '&HWVAL_' . $Apache::inputtags::response['-1'];
  310:                 $result.='\TextField[name='.$fieldname.',multiline=true,height=6\baselineskip,width=270,borderwidth=0,backgroundcolor={.85 .85 .85}]\\';
  311:             } else {
  312:                 my $TeXwidth=$width_of_box/80;
  313:                 $result = '\vskip 1 mm \fbox{\fbox{\parbox{'.$TeXwidth.'\textwidth-5mm}{';
  314:                 for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
  315:                 $result.='}}}\vskip 2 mm ';
  316:             }
  317: 	}
  318:     }
  319:     return $result;
  320: }
  321: 
  322: sub end_textfield {
  323:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  324:     my $result;
  325:     if ($target eq 'web') {
  326: 	my $spellcheck = &Apache::lonxml::get_param('spellcheck', $parstack, $safeeval);
  327: 	$Apache::lonxml::evaluate++;
  328: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  329:             my $partid=$Apache::inputtags::part;
  330: 	    my $resid = $Apache::inputtags::response[-1];
  331: 	    my $itemid = 'HWVAL_' . $partid . '_' . $resid;
  332: 	    my $result =  "</textarea>";
  333: 	    $result .= &spellcheck_onblur($itemid, $spellcheck);
  334: 	    return $result;
  335: 	}
  336:     } elsif ($target eq 'edit') {
  337: 	$result=&Apache::edit::end_table();
  338:     }
  339:     &end_input;
  340:     return $result;
  341: }
  342: 
  343: sub exam_score_line {
  344:     my ($target) = @_;
  345: 
  346:     my $result;
  347:     if ($target eq 'tex') {
  348: 	my $repetition = &Apache::response::repetition();
  349: 	$result.='\begin{enumerate}';
  350: 	if ($env{'request.state'} eq "construct" ) {$result.='\item[\strut]';}
  351: 	foreach my $i (0..$repetition-1) {
  352: 	    $result.='\item[\textbf{'.
  353: 		($Apache::lonxml::counter+$i).
  354: 		'}.]\textit{Leave blank on scoring form}\vskip 0 mm';
  355: 	}
  356: 	$result.= '\end{enumerate}';
  357:     }
  358: 
  359:     return $result;
  360: }
  361: 
  362: sub exam_box {
  363:     my ($target) = @_;
  364:     my $result;
  365: 
  366:     if ($target eq 'tex') {
  367: 	$result .= '\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';
  368: 	$result .= &exam_score_line($target);
  369:     } elsif ($target eq 'web') {
  370: 	my $id=$Apache::inputtags::response[-1];
  371: 	$result.= '<br /><br />
  372:                    <textarea name="HWVAL_'.$id.'" rows="4" cols="50">
  373:                    </textarea> <br /><br />';
  374:     }
  375:     return $result;
  376: }
  377: 
  378: sub needs_exam_box {
  379:     my ($tagstack) = @_;
  380:     my @tags = ('formularesponse',
  381: 		'stringresponse',
  382: 		'reactionresponse',
  383: 		'organicresponse',
  384: 		);
  385: 
  386:     foreach my $tag (@tags) {
  387: 	if (grep(/\Q$tag\E/,@$tagstack)) {
  388: 	    return 1;
  389: 	}
  390:     }
  391:     return 0;
  392: }
  393: 
  394: sub start_textline {
  395:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  396:     my $result = "";
  397:     my $input_id = &start_input($parstack,$safeeval);
  398: 
  399:     # The spellcheck attribute 
  400:     # 1. enables spellchecking.
  401:     # 2. Provides the language code in which the spellchecking will be performed.
  402: 
  403:     my $spellcheck = &Apache::lonxml::get_param('spellcheck', $parstack, $safeeval);
  404:     if ($target eq 'web') {
  405: 	$Apache::lonxml::evaluate--;
  406: 	my $partid=$Apache::inputtags::part;
  407: 	my $id=$Apache::inputtags::response[-1];
  408: 	if (!&Apache::response::show_answer()) {
  409: 	    my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
  410: 	    my $maxlength;
  411: 	    if ($size eq '') { $size=20; } else {
  412: 		if ($size < 20) {
  413: 		    $maxlength = ' maxlength="'.$size.'"';
  414: 		}
  415: 	    }
  416:             my ($oldresponse,$newvariation);
  417:             if ((($Apache::lonhomework::history{"resource.$partid.type"} eq 'randomizetry') ||
  418:                  ($Apache::lonhomework::type eq 'randomizetry')) &&
  419:                  ($Apache::inputtags::status[-1] eq 'CAN_ANSWER')) {
  420:                 if ($env{'form.'.$partid.'.rndseed'} ne
  421:                     $Apache::lonhomework::history{"resource.$partid.rndseed"}) {
  422:                     $newvariation = 1;
  423:                 }
  424:             }
  425:             unless ($newvariation) {
  426:                 if ((($env{'form.grade_username'} eq '') && ($env{'form.grade_domain'} eq '')) ||
  427:                     (($env{'form.grade_username'} eq $env{'user.name'}) &&
  428:                      ($env{'form.grade_domain'} eq $env{'user.domain'}))) {
  429:                     $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
  430:                 } elsif (($Apache::lonhomework::history{"resource.$partid.type"} eq 'anonsurvey') ||
  431:                         ($Apache::lonhomework::history{"resource.$partid.type"} eq 'anonsurveycred') ||
  432:                         ($Apache::lonhomework::type eq 'anonsurvey') ||
  433:                         ($Apache::lonhomework::type eq 'anonsurveycred')) {
  434:                         $oldresponse = '* '.&mt('(only shown to submitter)').' *';
  435:                 } else {
  436:                     $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
  437:                 }
  438: 	        &Apache::lonxml::debug("oldresponse $oldresponse is ".ref($oldresponse));
  439: 	        if (ref($oldresponse) eq 'ARRAY') {
  440: 		    $oldresponse = $oldresponse->[$#Apache::inputtags::inputlist];
  441: 	        }
  442: 	        $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"');
  443:                 $oldresponse =~ s/^\s+//;
  444:                 $oldresponse =~ s/\s+$//;
  445:                 $oldresponse =~ s/\s+/ /g;
  446:             }
  447: 	    if ($Apache::lonhomework::type ne 'exam') {
  448: 		my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
  449: 		$result='';
  450: 		if ($addchars) {
  451: 		    $result.=&addchars('HWVAL_'.$id,$addchars);
  452: 		}
  453: 		my $readonly=&Apache::lonxml::get_param('readonly',$parstack,
  454: 							$safeeval);
  455: 		if (lc($readonly) eq 'yes' 
  456: 		    || $Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
  457: 		    $readonly=' readonly="readonly" ';
  458: 		} else {
  459: 		    $readonly='';
  460: 		}
  461: 		my $name = 'HWVAL_'.$id;
  462:                 my $itemid = 'HWVAL_'.$partid.'_'.$id;
  463: 		if ($Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
  464: 		    $name = "none";
  465: 		}
  466: 		$result.= '<input onkeydown="javascript:setSubmittedPart(\''.$partid.'\');"'
  467: 		     . ' onfocus="javascript:disableAutoComplete(\''.$itemid.'\');"'
  468: 		     . ' type="text" '.$readonly.' name="'. $name . '"'
  469: 		     . ' id="' . $itemid . '"'
  470: 		     . ' value="'.  $oldresponse.'"'
  471: 		     . ' class="LC_textline spellchecked"  size="'.$size.'"'.$maxlength.' />';
  472: 
  473: 		$result .= &spellcheck_onblur($itemid, $spellcheck);
  474: 	    }
  475: 	    if ($Apache::lonhomework::type eq 'exam'
  476: 		&& &needs_exam_box($tagstack)) {
  477: 		$result.=&exam_box($target);
  478: 	    }
  479: 	} else {
  480: 	    #right or wrong don't show what was last typed in.
  481: 	    my $count = scalar(@Apache::inputtags::inputlist)-1;
  482: 	    $result='<b>'.$Apache::inputtags::answertxt{$id}[$count].'</b>';
  483: 	    #$result='';
  484: 	}
  485:     } elsif ($target eq 'edit') {
  486: 	$result=&Apache::edit::tag_start($target,$token);
  487: 	$result.=&Apache::edit::text_arg('Size:','size',$token,'5').
  488: 	    &Apache::edit::text_arg('Click-On Texts (comma sep):',
  489: 				    'addchars',$token,10);
  490:         $result.=&Apache::edit::select_arg('Readonly:','readonly',
  491: 					   ['no','yes'],$token);
  492:         my $spell_langs = &spelling_languages();
  493: 	$result.=&Apache::edit::select_arg('Spellcheck for:', 'spellcheck',
  494: 					   $spell_langs, $token);
  495: 	$result.=&Apache::edit::end_row();
  496: 	$result.=&Apache::edit::end_table();
  497:     } elsif ($target eq 'modified') {
  498: 	my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  499: 						     $safeeval,'size',
  500: 						     'addchars','readonly', 'spellcheck');
  501: 	if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
  502:     } elsif ($target eq 'tex' 
  503: 	     && $Apache::lonhomework::type ne 'exam') {
  504: 	my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
  505: 	if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';}
  506: 	if ($env{'form.pdfFormFields'} eq 'yes'
  507:             && $Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  508:             my $fieldname = $env{'request.symb'}.
  509:                                  '&part_'. $Apache::inputtags::part.
  510:                                  '&textresponse'.
  511:                                  '&HWVAL_' . $Apache::inputtags::response['-1'];
  512:             $result='\textField{'.$fieldname.'}{'.$size.'}{12 bp}';
  513:         } else {
  514:             $result='\framebox['.$size.'][s]{\tiny\strut}';
  515:         }
  516:     } elsif ($target eq 'tex' 
  517: 	     && $Apache::lonhomework::type eq 'exam'
  518: 	     && &needs_exam_box($tagstack)) {
  519: 	$result.=&exam_box($target);
  520:     }
  521:     return $result;
  522: }
  523: 
  524: sub end_textline {
  525:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  526:     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  527:     elsif ($target eq 'edit') { return ('','no'); }
  528:     &end_input();
  529:     return "";
  530: }
  531: 
  532: sub start_hiddenline {
  533:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  534:     my $result = "";
  535:     my $input_id = &start_input($parstack,$safeeval);
  536:     if ($target eq 'web') {
  537: 	$Apache::lonxml::evaluate--;
  538: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  539: 	    my $partid=$Apache::inputtags::part;
  540: 	    my $id=$Apache::inputtags::response[-1];
  541: 	    my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
  542: 	    if (ref($oldresponse) eq 'ARRAY') {
  543: 		$oldresponse = $oldresponse->[$#Apache::inputtags::inputlist];
  544: 	    }
  545: 	    $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"');
  546: 
  547: 	    if ($Apache::lonhomework::type ne 'exam') {
  548: 		$result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.
  549: 		    $oldresponse.'" />';
  550: 	    }
  551: 	}
  552:     } elsif ($target eq 'edit') {
  553: 	$result=&Apache::edit::tag_start($target,$token);
  554: 	$result.=&Apache::edit::end_table;
  555:     }
  556: 
  557:     if ( ($target eq 'web' || $target eq 'tex')
  558: 	 && $Apache::lonhomework::type eq 'exam'
  559: 	 && &needs_exam_box($tagstack)) {
  560: 	$result.=&exam_box($target);
  561:     }
  562:     return $result;
  563: }
  564: 
  565: sub end_hiddenline {
  566:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  567:     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  568:     elsif ($target eq 'edit') { return ('','no'); }
  569:     &end_input();
  570:     return "";
  571: }
  572: 
  573: 
  574: sub start_hiddensubmission {
  575:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  576:     my $result = "";
  577:     my $input_id = &start_input($parstack,$safeeval);
  578:     if ($target eq 'web') {
  579:         $Apache::lonxml::evaluate--;
  580:         if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  581:             my $partid=$Apache::inputtags::part;
  582:             my $id=$Apache::inputtags::response[-1];
  583:             if ($Apache::lonhomework::type ne 'exam') {
  584:                 my $value = &Apache::lonxml::get_param('value',$parstack,$safeeval);
  585:                 $value = &HTML::Entities::encode($value,'<>&"');
  586:                 $result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.$value.'" />';
  587:             }
  588:         }
  589:     } elsif ($target eq 'edit') {
  590:         $result=&Apache::edit::tag_start($target,$token);
  591:         $result.=&Apache::edit::text_arg('Value:','value',$token,'15');
  592:         $result.=&Apache::edit::end_row();
  593:         $result.=&Apache::edit::end_table();
  594:     } elsif ($target eq 'modified') {
  595:         my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  596:                                                      $safeeval,'value');
  597:         if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
  598:     }
  599: 
  600:     if ( ($target eq 'web' || $target eq 'tex')
  601:          && $Apache::lonhomework::type eq 'exam'
  602:          && &needs_exam_box($tagstack)) {
  603:         $result.=&exam_box($target);
  604:     }
  605:     return $result;
  606: }
  607: 
  608: sub end_hiddensubmission {
  609:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  610:     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  611:     elsif ($target eq 'edit') { return ('','no'); }
  612:     &end_input();
  613:     return "";
  614: }
  615: 
  616: =pod
  617: 
  618: =item file_selector()
  619: 
  620: $part -> partid
  621: $id -> responseid
  622: $uploadefiletypes -> comma seperated list of extensions allowed or * for any
  623: $which -> 'uploadonly'  -> only newly uploaded files
  624:           'portfolioonly' -> only allow files from portfolio
  625:           'both' -> allow files from either location
  626: $extratext -> additional text to go between the link and the input box
  627: $maxfilesize -> maximum cumulative filesize for submitted files (in MB).
  628: returns a table row <tr> 
  629: 
  630: =cut
  631: 
  632: sub file_selector {
  633:     my ($part,$id,$uploadedfiletypes,$which,$extratext,$maxfilesize)=@_;
  634:     if (!$uploadedfiletypes) { return ''; }
  635: 
  636:     my $jspart=$part;
  637:     $jspart=~s/\./_/g;
  638: 
  639:     my $result;
  640:     my $current_files_display = &current_file_submissions($part,$id);
  641:     my $addfiles;
  642:     if ($current_files_display) {
  643:         $result .= &Apache::lonhtmlcommon::row_title(&mt('Files currently selected for submission')).
  644:                    $current_files_display.
  645:                    &Apache::lonhtmlcommon::row_closure();
  646:         $addfiles = &mt('Submit other file(s)');
  647:     } else {
  648:         $addfiles = &mt('Choose file(s) to submit');
  649:     }
  650:     $result .= &Apache::lonhtmlcommon::row_title($addfiles);
  651:     my $constraints;
  652:     if ($uploadedfiletypes ne '*') {
  653: 	$constraints =
  654: 	    &mt('Allowed filetypes: [_1]','<b>'.$uploadedfiletypes.'</b>').'<br />';
  655:     }
  656:     if ($maxfilesize) {
  657:         $constraints .= &mt('Combined size of all files not to exceed: [_1] MB.',
  658:                         '<b>'.$maxfilesize.'</b>').'<br />';
  659:     }
  660:     if ($constraints) {
  661:         $result .= $constraints.'<br />';
  662:     }
  663:     if ($which eq 'uploadonly' || $which eq 'both') { 
  664: 	$result.=&mt('Submit a file: (only one file per submission)').
  665: 	    ' <br /><input type="file" size="50" name="HWFILE'.
  666: 	    $jspart.'_'.$id.'" id="HWFILE'.$jspart.'_'.$id.'" /><br />';
  667:     }
  668:     if ( $which eq 'both') {
  669: 	$result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';
  670:     }
  671:     if ($which eq 'portfolioonly' || $which eq 'both') {
  672:         my $symb = $env{'request.symb'};
  673:         (undef,undef,my $res)=&Apache::lonnet::decode_symb($symb);
  674:         my $showsymb;
  675:         # If resource is a .task and URL is unencrypted, include symb in query string
  676:         # for url opened in portfolio file selection window. Can be used to override
  677:         # blocking of portfolio access resulting from an exam event in a different course. 
  678:         if ($res =~ /\.task$/i) {
  679:             my $encsymb = &Apache::lonenc::check_encrypt($symb);
  680:             if ($symb eq $encsymb) {
  681:                 $showsymb = $symb;
  682:             }
  683:         }
  684: 	$result.=$extratext.'<a href='."'".'javascript:void(window.open("/adm/portfolio?mode=selectfile&amp;fieldname='.$env{'form.request.prefix'}.'HWPORT'.$jspart.'_'.$id.'&amp;symb='.$showsymb.'","cat","height=600,width=800,scrollbars=1,resizable=1,menubar=2,location=1"))'."'".'>'.
  685: 	    &mt('Select Portfolio Files: (one or more files per submission)').'</a><br />'.
  686: 	    '<input type="text" size="50" name="HWPORT'.$jspart.'_'.$id.'" value="" />'.
  687: 	    '<br />';
  688: 
  689:     }
  690:     $result.=&Apache::lonhtmlcommon::row_closure(1);
  691:     return $result;
  692: }
  693: 
  694: sub current_file_submissions {
  695:     my ($part,$id) = @_;
  696:     my $jspart=$part;
  697:     $jspart=~s/\./_/g;
  698:     my $uploadedfile=$Apache::lonhomework::history{"resource.$part.$id.uploadedfile"};
  699:     my $portfiles=$Apache::lonhomework::history{"resource.$part.$id.portfiles"};
  700:     return if (($uploadedfile eq '') && ($portfiles !~/[^\s]/));
  701:     my @unversioned;
  702:     foreach my $file (split(/\s*,\s*/,&unescape($portfiles))) {
  703:         my ($path,$name) = ($file =~ m{^(.*/)([^/]+)$});
  704:         my ($origname,$version,$ext) = &Apache::lonnet::file_name_version_ext($name);
  705:         unless ($version) {
  706:             push(@unversioned,$file);
  707:         }    
  708:     }
  709:     return if (!@unversioned);
  710:     my $header = &portpath_popup_js().
  711:                  &Apache::loncommon::start_data_table().
  712:                  &Apache::loncommon::start_data_table_header_row();
  713:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  714:         $header .= '<th>'.&mt('Delete?').'</th>';
  715:     }
  716:     $header .=   '<th>'.&mt('File').'</th>'.
  717:                  '<th>'.&mt('Size (MB)').'</th>'.
  718:                  '<th>'.&mt('Last Modified').'</th>'.
  719:                  &Apache::loncommon::end_data_table_header_row();
  720:     my ($symb,$crsid,$udom,$uname)=&Apache::lonnet::whichuser();
  721:     my ($cdom,$cnum) = ($crsid =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/);
  722:     my ($result,$header_shown,%okfiles,%rows,%legacy,@bad_file_list);
  723:     if ($uploadedfile) {
  724:         my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
  725:         my $link = &HTML::Entities::encode($url,'<>&"');
  726:         my ($path,$name) = ($url =~ m{^(/uploaded/\Q$udom\E/\Q$uname\E/essayresponse.*/)([^/]+)$});
  727:         my ($status,$hashref,$error) =
  728:             &current_file_info($url,$link,$name,$path);
  729:         if ($status eq 'ok') {
  730:             push(@{$okfiles{$name}},$url);
  731:             $rows{$url} = $hashref;
  732:             $legacy{$url} = 1;
  733:             &Apache::lonxml::extlink($url);
  734:             &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);
  735:         } else {
  736:             push(@bad_file_list,$error);
  737:         }
  738:     }
  739:     if (@unversioned > 0) {
  740:         my $prefix = "/uploaded/$udom/$uname/portfolio";
  741:         foreach my $file (@unversioned) {
  742:             my ($path,$name) = ($file =~ m{^(.*/)([^/]+)$});
  743:             my $url = $prefix.$path.$name;
  744:             my $uploadedfile = &HTML::Entities::encode($url,'<>&"');
  745:             my ($status,$hashref,$error) =
  746:                 &current_file_info($url,$uploadedfile,$name,$path);
  747:             if ($status eq 'ok') {
  748:                 push(@{$okfiles{$name}},$url);
  749:                 $rows{$url} = $hashref;
  750:             } else {
  751:                 push(@bad_file_list,$error);
  752:             }
  753:         }
  754:     }
  755:     my $num = 0;
  756:     foreach my $name (sort(keys(%okfiles))) {
  757:         if (ref($okfiles{$name}) eq 'ARRAY') {
  758:             foreach my $url (@{$okfiles{$name}}) {
  759:                 if (ref($rows{$url}) eq 'HASH') {
  760:                     my $link = $rows{$url}{link};
  761:                     my $portfile = $rows{$url}{path}.$rows{$url}{name};
  762:                     $portfile = &HTML::Entities::encode($portfile,'<>&"');
  763:                     if ($link) {
  764:                         my $icon=&Apache::loncommon::icon($url);
  765:                         unless ($header_shown) {
  766:                             $result .= $header;
  767:                             $header_shown = 1;
  768:                         }
  769:                         $result.=
  770:                             &Apache::loncommon::start_data_table_row()."\n";
  771:                         if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  772:                             $result .=
  773:                                  '<td valign="bottom"><input type="checkbox" name="HWFILE'.$jspart.'_'.$id.'_delete"'.
  774:                                  ' value="'.$portfile.'" id="HWFILE'.$jspart.'_'.$id.'_'.$num.'_delete" /></td>'."\n";
  775:                             $num ++;
  776:                         }
  777:                         my $pathid = 'HWFILE'.$jspart.'_'.$id.'_'.$num.'_path';
  778:                         my $pathidtext = $pathid.'text';
  779:                         my ($showname,$showpath);
  780:                         if ($legacy{$url}) {
  781:                             $showname = $name.' '.&mt('not in portfolio');
  782:                         } else {
  783:                             $showname = $name;
  784:                             $showpath = '<br />'. 
  785:                                         '<span id="'.$pathidtext.'" class="LC_cusr_subheading">'.
  786:                                         '<a href="javascript:showPortPath('."'$pathid','$pathidtext'".');" '.
  787:                                         'class="LC_menubuttons_link">'.
  788:                                         &mt('(Show path)').'</a></span>'.
  789:                                         '<div id="'.$pathid.'" class="LC_dccid">'.$rows{$url}{path}.$name.
  790: '</div>';
  791:                         }
  792:                         $result .= 
  793:                             '<td><a href="'.$link.'"><img src="'.$icon.
  794:                             '" border="0" alt="" />'.$showname.'</a>'.$showpath.'</td>'."\n".
  795:                             '<td align="right" valign="bottom">'.$rows{$url}{size}.'</td>'."\n".
  796:                             '<td align="right" valign="bottom">'.$rows{$url}{lastmodified}.'</td>'."\n".
  797:                             &Apache::loncommon::end_data_table_row();
  798:                     }
  799:                 }
  800:             }
  801:         }
  802:     }
  803:     if ($header_shown) {
  804:         $result .= &Apache::loncommon::end_data_table();
  805:         if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  806:             $result .= '<br /><span class="LC_warning">'.
  807:                        &mt('Exclude existing file(s) from grading by checking the "Delete?" checkbox(es) and clicking "Submit Answer"').'</span>';
  808:         }
  809:     }
  810:     if (@bad_file_list) {
  811:         my $bad_files = '<span class="LC_filename">'.
  812:             join('</span>, <span class="LC_filename">',@bad_file_list).
  813:             '</span>';
  814:         $result.='<p class="LC_error">'.
  815:                  &mt("These file(s) don't exist: [_1]",$bad_files).
  816:                  '</p>';
  817:     }
  818:     return $result;
  819: }
  820: 
  821: sub current_file_info {
  822:     my ($url,$uploadedfile,$name,$path) = @_;
  823:     my ($status,$error,%info);
  824:     my @stat = &Apache::lonnet::stat_file($url);
  825:     if ((@stat) && ($stat[0] ne 'no_such_dir')) {
  826:         my ($lastmod,$size);
  827:         if ($stat[9] =~ /^\d+$/) {
  828:             $lastmod = &Apache::lonlocal::locallocaltime($stat[9]);
  829:         }
  830:         $size = $stat[7]/(1024*1024);
  831:         $size = sprintf("%.3f",$size);
  832:         %info = (
  833:                     link         => $uploadedfile,
  834:                     name         => $name,
  835:                     path         => $path,
  836:                     size         => $size,
  837:                     lastmodified => $lastmod,
  838:                 );
  839:         $status = 'ok';
  840:     } else {
  841:         &Apache::lonnet::logthis("bad file is $url");
  842:         my $icon=&Apache::loncommon::icon($url);
  843:         $error = '<a href="'.$url.'"><img src="'.$icon.
  844:                  '" border="0" />'.$uploadedfile.'</a>';
  845:     }
  846:     return ($status,\%info,$error);
  847: }
  848: 
  849: sub portpath_popup_js {
  850:     my %lt = &Apache::lonlocal::texthash(
  851:                                           show => '(Show path)',
  852:                                           hide => '(Hide)',
  853:                                         );
  854:     return <<"END";
  855: <script type="text/javascript"> 
  856: // <![CDATA[
  857: 
  858: function showPortPath(id,idtext) {
  859:     document.getElementById(id).style.display='block';
  860:     document.getElementById(id).style.textAlign='left';
  861:     document.getElementById(id).style.textFace='normal';
  862:     if (document.getElementById(idtext)) {
  863:         document.getElementById(idtext).innerHTML ='<a href="javascript:hidePortPath(\\''+id+'\\',\\''+idtext+'\\'); '+
  864:                                                    '"class="LC_menubuttons_link">$lt{'hide'}</a>&nbsp;';
  865:     }
  866:     return;
  867: }
  868: 
  869: function hidePortPath(id,idtext) {
  870:     if (document.getElementById(id)) {
  871:         document.getElementById(id).style.display='none';
  872:     }
  873:     if (document.getElementById(idtext)) {
  874:         document.getElementById(idtext).innerHTML ='<a href="javascript:showPortPath(\\''+id+'\\',\\''+idtext+'\\');" '+
  875:                                                    'class="LC_menubuttons_link">$lt{'show'}</a>';
  876:     }
  877:     return;
  878: }
  879: 
  880: // ]]>
  881: </script>
  882: 
  883: END
  884: }
  885: 
  886: sub valid_award {
  887:     my ($award) =@_;
  888:     foreach my $possibleaward ('EXTRA_ANSWER','MISSING_ANSWER', 'ERROR',
  889: 			       'NO_RESPONSE','WRONG_NUMBOXESCHECKED',
  890: 			       'TOO_LONG', 'UNIT_INVALID_INSTRUCTOR',
  891: 			       'UNIT_INVALID_STUDENT', 'UNIT_IRRECONCIBLE',
  892: 			       'UNIT_FAIL', 'NO_UNIT',
  893: 			       'UNIT_NOTNEEDED', 'WANTED_NUMERIC',
  894: 			       'BAD_FORMULA', 'NOT_FUNCTION', 'WRONG_FORMAT', 
  895:                                'INTERNAL_ERROR', 'SIG_FAIL', 'INCORRECT', 
  896: 			       'MISORDERED_RANK', 'INVALID_FILETYPE',
  897:                                'EXCESS_FILESIZE', 'FILENAME_INUSE', 
  898: 			       'DRAFT', 'SUBMITTED', 'SUBMITTED_CREDIT', 
  899:                                'ANONYMOUS', 'ANONYMOUS_CREDIT',
  900:                                'ASSIGNED_SCORE', 'APPROX_ANS',
  901: 			       'EXACT_ANS','COMMA_FAIL') {
  902: 	if ($award eq $possibleaward) { return 1; }
  903:     }
  904:     return 0;
  905: }
  906: 
  907: {
  908:     my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',
  909: 		  'WRONG_NUMCHECKEDBOXES','TOO_LONG',
  910: 		  'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT',
  911: 		  'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT',
  912: 		  'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA',  'NOT_FUNCTION', 
  913:                   'WRONG_FORMAT', 'INTERNAL_ERROR',
  914: 		  'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK',
  915: 		  'INVALID_FILETYPE', 'EXCESS_FILESIZE', 'FILENAME_INUSE', 
  916:                   'DRAFT', 'SUBMITTED',
  917:                   'SUBMITTED_CREDIT', 'ANONYMOUS', 'ANONYMOUS_CREDIT',
  918:                   'ASSIGNED_SCORE', 'APPROX_ANS', 'EXACT_ANS');
  919:     my $i=0;
  920:     my %fwd_awards = map { ($_,$i++) } @awards;
  921:     my $max=scalar(@awards);
  922:     @awards=reverse(@awards);
  923:     $i=0;
  924:     my %rev_awards = map { ($_,$i++) } @awards;
  925: 
  926: sub awarddetail_to_awarded {
  927:     my ($awarddetail) = @_;
  928:     if ($awarddetail eq 'EXACT_ANS'
  929: 	|| $awarddetail eq 'APPROX_ANS') {
  930: 	return 1;
  931:     }
  932:     return 0;
  933: }
  934: 
  935: sub hide_award {
  936:     my ($award) = @_;
  937:     if (&Apache::lonhomework::show_no_problem_status()) {
  938: 	return 1;
  939:     }
  940:     if ($award =~
  941: 	/^(?:EXACT_ANS|APPROX_ANS|SUBMITTED|SUBMITTED_CREDIT|ANONYMOUS|ANONYMOUS_CREDIT|ASSIGNED_SCORE|INCORRECT)/) {
  942: 	return 1;
  943:     }
  944:     return 0;
  945: }
  946: 
  947: sub finalizeawards {
  948:     my ($awardref,$msgref,$nameref,$reverse,$final_scantron)=@_;
  949:     my $result;
  950:     if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
  951:     if ($result eq '' ) {
  952: 	my $blankcount;
  953: 	foreach my $award (@$awardref) {
  954: 	    if ($award eq '') {
  955: 		$result='MISSING_ANSWER';
  956: 		$blankcount++;
  957: 	    }
  958: 	}
  959: 	if ($blankcount == ($#$awardref + 1)) {
  960: 	    return ('NO_RESPONSE');
  961: 	}
  962:     }
  963: 
  964:     if ($Apache::lonxml::internal_error) { $result='INTERNAL_ERROR'; }
  965: 
  966:     if (!$final_scantron && defined($result)) { return ($result); }
  967: 
  968:     # if in scantron mode, if the award for any response is 
  969:     # assigned score, then the part gets an assigned score
  970:     if ($final_scantron 
  971: 	&& grep {$_ eq 'ASSIGNED_SCORE'} (@$awardref)) {
  972: 	return ('ASSIGNED_SCORE');
  973:     }
  974: 
  975:     # if in scantron mode, if the award for any response is 
  976:     # correct and there are non-correct responses,
  977:     # then the part gets an assigned score
  978:     if ($final_scantron 
  979: 	&& (grep { $_ eq 'EXACT_ANS' ||
  980: 		   $_ eq 'APPROX_ANS'  } (@$awardref))
  981: 	&& (grep { $_ ne 'EXACT_ANS' &&
  982: 		   $_ ne 'APPROX_ANS'  } (@$awardref))) {
  983: 	return ('ASSIGNED_SCORE');
  984:     }
  985:     # these awards are ordered from most important error through best correct
  986:     my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ;
  987: 
  988:     my $best = $max;
  989:     my $j=0;
  990:     my $which;
  991:     foreach my $award (@$awardref) {
  992: 	if ($awards->{$award} < $best) {
  993: 	    $best  = $awards->{$award};
  994: 	    $which = $j;
  995: 	}
  996: 	$j++;
  997:     }
  998: 
  999:     # if at least one response item is set to include lenient grading
 1000:     # and that item is partially correct then overall award reflects
 1001:     # that, unless an award for one of the other response items does
 1002:     # not fall within the basic awards for correct or incorrect.
 1003:     if ($Apache::inputtags::leniency) {
 1004:         if (($$awardref[$which] eq 'INCORRECT')
 1005:             && (grep { $_ eq 'EXACT_ANS' ||
 1006:                        $_ eq 'APPROX_ANS' ||
 1007:                        $_ eq 'ASSIGNED_SCORE' } (@$awardref))
 1008:             && !((grep { $_ ne 'INCORRECT' &&
 1009:                          $_ ne 'EXACT_ANS' &&
 1010:                          $_ ne 'APPROX_ANS' &&
 1011:                          $_ ne 'ASSIGNED_SCORE' } (@$awardref)))) {
 1012:             return ('ASSIGNED_SCORE');
 1013:         }
 1014:     }
 1015: 
 1016:     if (defined($which)) {
 1017: 	if (ref($nameref)) {
 1018: 	    return ($$awardref[$which],$$msgref[$which],$$nameref[$which]);
 1019: 	} else {
 1020: 	    return ($$awardref[$which],$$msgref[$which]);
 1021: 	}
 1022:     }
 1023:     return ('ERROR',undef);
 1024: }
 1025: }
 1026: 
 1027: sub decideoutput {
 1028:     my ($award,$awarded,$awardmsg,$solved,$previous,$target,$nocorrect,$tdclass)=@_;
 1029: 
 1030:     my $message='';
 1031:     my $button=0;
 1032:     my $previousmsg;
 1033:     my $css_class='orange';
 1034:     my $added_computer_text=0;
 1035:     my %possible_class =
 1036: 	( 'correct'         => 'LC_answer_correct',
 1037: 	  'charged_try'     => 'LC_answer_charged_try',
 1038: 	  'not_charged_try' => 'LC_answer_not_charged_try',
 1039: 	  'no_grade'        => 'LC_answer_no_grade',
 1040: 	  'no_message'      => 'LC_no_message',
 1041: 	  );
 1042: 
 1043:     my $part = $Apache::inputtags::part;
 1044:     my $tohandgrade = &Apache::lonnet::EXT("resource.$part.handgrade");
 1045:     my $handgrade = ('yes' eq lc($tohandgrade)); 
 1046: #
 1047: # Should "Computer's Answer" be displayed?
 1048: # Should not be displayed if still answerable,
 1049: # if the problem is handgraded,
 1050: # or if the problem does not give a correct answer
 1051: #
 1052:     
 1053:     my $computer = ($handgrade || $nocorrect)? ''
 1054: 	                       : " ".&mt("Computer's answer now shown above.");
 1055:     &Apache::lonxml::debug("handgrade has :$handgrade:");
 1056: 
 1057:     if ($previous) { $previousmsg=&mt('You have entered that answer before'); }
 1058:     
 1059:     if ($solved =~ /^correct/) {
 1060:         $css_class=$possible_class{'correct'};
 1061: 	$message=&mt('You are correct.');
 1062: 	if ($awarded < 1 && $awarded > 0) {
 1063: 	    $message=&mt('You are partially correct.');
 1064: 	    $css_class=$possible_class{'not_charged_try'};
 1065: 	} elsif ($awarded < 1) {
 1066: 	    $message=&mt('Incorrect.');
 1067: 	    $css_class=$possible_class{'charged_try'};
 1068: 	}
 1069: 	if ($handgrade || 
 1070:             ($env{'request.filename'}=~/\/res\/lib\/templates\/(examupload|DropBox).problem$/)) {
 1071: 	    $message = &mt("A score has been assigned.");
 1072: 	    $added_computer_text=1;
 1073: 	} else {
 1074: 	    if ($target eq 'tex') {
 1075: 		$message = '\textbf{'.$message.'}';
 1076: 	    } else {
 1077: 		$message = "<b>".$message."</b>";
 1078: 		$message.= $computer;
 1079: 	    }
 1080: 	    $added_computer_text=1;
 1081: 	    if ($awarded > 0) {
 1082: 		my ($symb) = &Apache::lonnet::whichuser();
 1083: 		if (($symb ne '') 
 1084: 		    &&
 1085: 		    ($env{'course.'.$env{'request.course.id'}.
 1086: 			      '.disable_receipt_display'} ne 'yes') &&
 1087:                     ($Apache::lonhomework::type ne 'practice')) { 
 1088: 		    $message.=(($target eq 'web')?'<br />':' ').
 1089: 			&mt('Your receipt no. is [_1]',
 1090: 			    (&Apache::lonnet::receipt($Apache::inputtags::part).
 1091: 			     (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'')));
 1092: 		}
 1093: 	    }
 1094: 	}
 1095:         if ($awarded >= 1) {
 1096:             $button=0;
 1097:         } elsif (&Apache::lonnet::EXT("resource.$part.retrypartial") !~/^1|on|yes$/i) {
 1098:             $button=0;
 1099:         } else {
 1100:             $button=1;
 1101:         }
 1102: 	$previousmsg='';
 1103:     } elsif ($solved =~ /^excused/) {
 1104: 	if ($target eq 'tex') {
 1105: 	    $message = ' \textbf{'.&mt('You are excused from the problem.').'} ';
 1106: 	} else {
 1107: 	    $message = "<b>".&mt('You are excused from the problem.')."</b>";
 1108: 	}
 1109: 	$css_class=$possible_class{'charged_try'};
 1110: 	$button=0;
 1111: 	$previousmsg='';
 1112:     } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
 1113: 	if ($solved =~ /^incorrect/ || $solved eq '') {
 1114: 	    $message = &mt("Incorrect").".";
 1115: 	    $css_class=$possible_class{'charged_try'};
 1116: 	    $button=1;
 1117: 	} else {
 1118: 	    if ($target eq 'tex') {
 1119: 		$message = '\textbf{'.&mt('You are correct.').'}';
 1120: 	    } else {
 1121: 		$message = "<b>".&mt('You are correct.')."</b>";
 1122: 		$message.= $computer;
 1123: 	    }
 1124: 	    $added_computer_text=1;
 1125: 	    if  ($awarded > 0 
 1126: 		 && $env{'course.'.
 1127: 			     $env{'request.course.id'}.
 1128: 			     '.disable_receipt_display'} ne 'yes') { 
 1129: 		$message.=(($target eq 'web')?'<br />':' ').
 1130: 		    &mt('Your receipt is [_1]',
 1131: 			(&Apache::lonnet::receipt($Apache::inputtags::part).
 1132: 			 (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'')));
 1133: 	    }
 1134: 	    $css_class=$possible_class{'correct'};
 1135: 	    $button=0;
 1136: 	    $previousmsg='';
 1137: 	}
 1138:     } elsif ($award eq 'NO_RESPONSE') {
 1139: 	$message = '';
 1140: 	$css_class=$possible_class{'no_feedback'};
 1141: 	$button=1;
 1142:     } elsif ($award eq 'EXTRA_ANSWER') {
 1143: 	$message = &mt('Some extra items were submitted.');
 1144: 	$css_class=$possible_class{'not_charged_try'};
 1145: 	$button = 1;
 1146:     } elsif ($award eq 'MISSING_ANSWER') {
 1147: 	$message = &mt('Some items were not submitted.');
 1148:         if ($target ne 'tex') {
 1149:            $message .= &Apache::loncommon::help_open_topic('Some_Items_Were_Not_Submitted');
 1150:         }
 1151: 	$css_class=$possible_class{'not_charged_try'};
 1152: 	$button = 1;
 1153:     } elsif ($award eq 'WRONG_NUMBOXESCHECKED') {
 1154:         $message = &mt('Number of boxes checked outside permissible range (either too few or too many).');
 1155:         if ($target ne 'tex') {
 1156:            $message .= &Apache::loncommon::help_open_topic('Wrong_Num_Boxes_Checked');
 1157:         }
 1158:         $css_class=$possible_class{'not_charged_try'};
 1159:         $button = 1;
 1160:     } elsif ($award eq 'ERROR') {
 1161: 	$message = &mt('An error occurred while grading your answer.');
 1162: 	$css_class=$possible_class{'not_charged_try'};
 1163: 	$button = 1;
 1164:     } elsif ($award eq 'TOO_LONG') {
 1165: 	$message = &mt("The submitted answer was too long.");
 1166: 	$css_class=$possible_class{'not_charged_try'};
 1167: 	$button=1;
 1168:     } elsif ($award eq 'WANTED_NUMERIC') {
 1169: 	$message = &mt("This question expects a numeric answer.");
 1170: 	$css_class=$possible_class{'not_charged_try'};
 1171: 	$button=1;
 1172:     } elsif ($award eq 'MISORDERED_RANK') {
 1173:         $message = &mt('You have provided an invalid ranking.');
 1174:         if ($target ne 'tex') {
 1175:             $message.=' '.&mt('Please refer to [_1]',&Apache::loncommon::help_open_topic('Ranking_Problems',&mt('help on ranking problems')));
 1176:         }
 1177: 	$css_class=$possible_class{'not_charged_try'};
 1178: 	$button=1;
 1179:     } elsif ($award eq 'EXCESS_FILESIZE') {
 1180:         $message = &mt("Submission won't be graded. The combined size of submitted files exceeded the amount allowed.");
 1181:         $css_class=$possible_class{'not_charged_try'};
 1182:         $button=1;
 1183:     } elsif ($award eq 'FILENAME_INUSE') {
 1184:         $message = &mt('You have already uploaded a file with that filename.');
 1185:         if ($target eq 'tex') {
 1186:             $message.= "\\\\\n";
 1187:         } else {
 1188:             $message .= '<br />';
 1189:         }
 1190:         $message .= &mt('Please use a different filename.');
 1191:         $css_class=$possible_class{'not_charged_try'};
 1192:         $button=1;
 1193:     } elsif ($award eq 'INVALID_FILETYPE') {
 1194: 	$message = &mt("Submission won't be graded. The type of file submitted is not allowed.");
 1195: 	$css_class=$possible_class{'not_charged_try'};
 1196: 	$button=1;
 1197:     } elsif ($award eq 'SIG_FAIL') {
 1198: 	my ($used,$min,$max)=split(':',$awardmsg);
 1199: 	my $word = ($used < $min) ? 'more' : 'fewer';
 1200: 	$message = &mt("Submission not graded. Use $word digits.",$used);
 1201: 	$css_class=$possible_class{'not_charged_try'};
 1202: 	$button=1;
 1203:     } elsif ($award eq 'UNIT_INVALID_INSTRUCTOR') {
 1204: 	$message = &mt('Error in instructor specifed unit. This error has been reported to the instructor.', $awardmsg);
 1205: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
 1206: 	$css_class=$possible_class{'not_charged_try'};
 1207: 	$button=1;
 1208:     } elsif ($award eq 'UNIT_INVALID_STUDENT') {
 1209: 	$message = &mt('Unable to interpret units. Computer reads units as "[_1]".',&markup_unit($awardmsg,$target));
 1210: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
 1211: 	$css_class=$possible_class{'not_charged_try'};
 1212: 	$button=1;
 1213:     } elsif ($award eq 'UNIT_FAIL' || $award eq 'UNIT_IRRECONCIBLE') {
 1214: 	$message = &mt('Incompatible units. No conversion found between "[_1]" and the required units.',&markup_unit($awardmsg,$target));
 1215: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
 1216: 	$css_class=$possible_class{'not_charged_try'};
 1217: 	$button=1;
 1218:     } elsif ($award eq 'UNIT_NOTNEEDED') {
 1219: 	$message = &mt('Only a number required. Computer reads units of "[_1]".',&markup_unit($awardmsg,$target));
 1220: 	$css_class=$possible_class{'not_charged_try'};
 1221: 	$button=1;
 1222:     } elsif ($award eq 'NO_UNIT') {
 1223: 	$message = &mt("Units required").'.';
 1224: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')};
 1225: 	$css_class=$possible_class{'not_charged_try'};
 1226: 	$button=1;
 1227:     } elsif ($award eq 'COMMA_FAIL') {
 1228: 	$message = &mt("Proper comma separation is required").'.';
 1229: 	$css_class=$possible_class{'not_charged_try'};
 1230: 	$button=1;
 1231:     } elsif ($award eq 'BAD_FORMULA') {
 1232: 	$message = &mt("Unable to understand formula").'.';
 1233:         if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Formula_Answers')};
 1234: 	$css_class=$possible_class{'not_charged_try'};
 1235: 	$button=1;
 1236:     } elsif ($award eq 'NOT_FUNCTION') {
 1237:         $message = &mt("Not a function").'.';
 1238:         $css_class=$possible_class{'not_charged_try'};
 1239:         $button=1;
 1240:     } elsif ($award eq 'WRONG_FORMAT') {
 1241:         $message = &mt("Wrong format").'.';
 1242:         $css_class=$possible_class{'not_charged_try'};
 1243:         $button=1;
 1244:      } elsif ($award eq 'INTERNAL_ERROR') {
 1245:         $message = &mt("An internal error occurred while processing your answer. Please try again later.");
 1246:         $css_class=$possible_class{'not_charged_try'};
 1247:         $button=1;
 1248:     } elsif ($award eq 'INCORRECT') {
 1249: 	$message = &mt("Incorrect").'.';
 1250: 	$css_class=$possible_class{'charged_try'};
 1251: 	$button=1;
 1252:     } elsif ($award eq 'SUBMITTED') {
 1253: 	$message = &mt("Your submission has been recorded.");
 1254: 	$css_class=$possible_class{'no_grade'};
 1255: 	$button=1;
 1256:     } elsif ($award eq 'SUBMITTED_CREDIT') {
 1257:         $message = &mt("Your submission has been recorded, and credit awarded.");
 1258:         $css_class=$possible_class{'correct'};
 1259:         $button=1;
 1260:     } elsif ($award eq 'ANONYMOUS') {
 1261:         $message = &mt("Your anonymous submission has been recorded.");
 1262:         $css_class=$possible_class{'no_grade'};
 1263:         $button=1;
 1264:     } elsif ($award eq 'ANONYMOUS_CREDIT') {
 1265:         $message = &mt("Your anonymous submission has been recorded, and credit awarded.");
 1266:         $css_class=$possible_class{'correct'};
 1267:         $button=1;
 1268:     } elsif ($award eq 'DRAFT') {
 1269: 	$message = &mt("Copy saved but not submitted.");
 1270: 	$css_class=$possible_class{'not_charged_try'};
 1271: 	$button=1;
 1272:     } elsif ($award eq 'ASSIGNED_SCORE') {
 1273: 	$message = &mt("A score has been assigned.");
 1274: 	$css_class=$possible_class{'correct'};
 1275: 	$button=0;
 1276:     } elsif ($award eq '') {
 1277: 	if ($handgrade && $Apache::inputtags::status[-1] eq 'SHOW_ANSWER') {
 1278: 	    $message = &mt("Nothing submitted.");
 1279: 	    $css_class=$possible_class{'charged_try'};
 1280: 	} else {
 1281: 	    $css_class=$possible_class{'not_charged_try'};
 1282: 	}
 1283: 	$button=1;
 1284:     } else {
 1285: 	$message = &mt("Unknown message").": $award";
 1286: 	$button=1;
 1287:     }
 1288:     my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser();
 1289:     foreach my $resid(@Apache::inputtags::response){
 1290:         if ($Apache::lonhomework::history{"resource.$part.$resid.handback"}) {
 1291:             if ($target eq 'tex') {
 1292:                 $message.= "\\\\\n";
 1293:             } else {
 1294:                 $message.='<br />';
 1295:             }
 1296: 	    my @files = split(/\s*,\s*/,
 1297: 			      $Apache::lonhomework::history{"resource.$part.$resid.handback"});
 1298: 	    my $file_msg;
 1299: 	    foreach my $file (@files) {
 1300:                 if ($target eq 'tex') {
 1301:                     $file_msg.= "\\\\\n".$file;
 1302:                 } else {
 1303:                     $file_msg.= '<br /><a href="/uploaded/'."$domain/$user".'/'.$file.'">'.$file.'</a>';
 1304:                 }
 1305: 	    }
 1306: 	    $message .= &mt('Returned file(s): [_1]',$file_msg);
 1307:             if ($target eq 'tex') {
 1308:                 $message.= "\\\\\n";
 1309:             } else {
 1310:                 $message.='<br />';
 1311:             }
 1312: 	}
 1313:     }
 1314: 
 1315:     if (&Apache::lonhomework::hide_problem_status()
 1316: 	&& $Apache::inputtags::status[-1] ne 'SHOW_ANSWER'
 1317: 	&& &hide_award($award)) {
 1318:         $message = &mt("Answer Submitted: Your final submission will be graded after the due date.");
 1319:         my @interval= &Apache::lonnet::EXT("resource.$part.interval");
 1320:         if ($interval[0] =~ /\d+/) {
 1321:             my $first_access=&Apache::lonnet::get_first_access($interval[1]);
 1322:             if (defined($first_access)) {
 1323:                 my $due_date= &Apache::lonnet::EXT("resource.$part.duedate");
 1324:                 unless (($due_date) && ($due_date < $first_access + $interval[0])) { 
 1325:                     $message = &mt("Answer Submitted: Your final submission will be graded when the time limit is reached.");
 1326:                 }
 1327:             }
 1328:         }
 1329: 	$css_class=$possible_class{'no_grade'};
 1330: 	$button=1;
 1331:     }
 1332:     if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && 
 1333: 	!$added_computer_text && $target ne 'tex') {
 1334: 	$message.= $computer;
 1335: 	$added_computer_text=1;
 1336:     }
 1337:     if ($Apache::lonhomework::type eq 'practice') {
 1338:        if ($target eq 'web') {
 1339:            $message .= '<br />';
 1340:        } else {
 1341:            $message .= ' ';      
 1342:        }
 1343:        $message.=&mt('Submissions to practice problems are not permanently recorded.');
 1344:     }
 1345:     return ($button,$css_class,$message,$previousmsg);
 1346: }
 1347: 
 1348: sub markup_unit {
 1349:     my ($unit,$target)=@_;
 1350:     if ($target eq 'tex') {
 1351: 	return '\texttt{'.&Apache::lonxml::latex_special_symbols($unit).'}'; 
 1352:     } else {
 1353: 	return "<tt>".$unit."</tt>";
 1354:     }
 1355: }
 1356: 
 1357: sub removealldata {
 1358:     my ($id)=@_;
 1359:     foreach my $key (keys(%Apache::lonhomework::results)) {
 1360: 	if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
 1361: 	    &Apache::lonxml::debug("Removing $key");
 1362: 	    delete($Apache::lonhomework::results{$key});
 1363: 	}
 1364:     }
 1365: }
 1366: 
 1367: sub hidealldata {
 1368:     my ($id)=@_;
 1369:     foreach my $key (keys(%Apache::lonhomework::results)) {
 1370: 	if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
 1371: 	    &Apache::lonxml::debug("Hidding $key");
 1372: 	    my $newkey=$key;
 1373: 	    $newkey=~s/^(resource\.\Q$id\E\.[^\.]+\.)(.*)$/${1}hidden${2}/;
 1374: 	    $Apache::lonhomework::results{$newkey}=
 1375: 		$Apache::lonhomework::results{$key};
 1376: 	    delete($Apache::lonhomework::results{$key});
 1377: 	}
 1378:     }
 1379: }
 1380: 
 1381: sub setgradedata {
 1382:     my ($award,$msg,$id,$previously_used) = @_;
 1383:     if ($Apache::lonhomework::scantronmode && 
 1384: 	&Apache::lonnet::validCODE($env{'form.CODE'})) {
 1385: 	$Apache::lonhomework::results{"resource.CODE"}=$env{'form.CODE'};
 1386:     } elsif ($Apache::lonhomework::scantronmode && 
 1387: 	     $env{'form.CODE'} eq '' &&
 1388: 	     $Apache::lonhomework::history{"resource.CODE"} ne '') {
 1389: 	$Apache::lonhomework::results{"resource.CODE"}='';
 1390:     }
 1391: 
 1392:     if (!$Apache::lonhomework::scantronmode &&
 1393: 	$Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
 1394: 	$Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {
 1395: 	$Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
 1396: 	return '';
 1397:     } elsif ( $Apache::lonhomework::history{"resource.$id.awarded"} < 1
 1398: 	      || $Apache::lonhomework::scantronmode 
 1399: 	      || &Apache::lonhomework::hide_problem_status()  ) {
 1400:         # the student doesn't already have it correct,
 1401: 	# or we are in a mode (scantron orno problem status) where a correct 
 1402:         # can become incorrect
 1403: 	# handle assignment of tries and solved status
 1404: 	my $solvemsg;
 1405: 	if ($Apache::lonhomework::scantronmode) {
 1406: 	    $solvemsg='correct_by_scantron';
 1407: 	} else {
 1408: 	    $solvemsg='correct_by_student';
 1409: 	}
 1410: 	if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
 1411: 	    $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
 1412: 	}
 1413: 	if ( $award eq 'ASSIGNED_SCORE') {
 1414: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
 1415: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1416: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
 1417: 		$solvemsg;
 1418: 	    my $numawards=scalar(@Apache::inputtags::response);
 1419: 	    $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
 1420: 	    foreach my $res (@Apache::inputtags::response) {
 1421: 		if (defined($Apache::lonhomework::results{"resource.$id.$res.awarded"})) {
 1422: 		    $Apache::lonhomework::results{"resource.$id.awarded"}+=
 1423: 			$Apache::lonhomework::results{"resource.$id.$res.awarded"};
 1424: 		} else {
 1425: 		    $Apache::lonhomework::results{"resource.$id.awarded"}+=
 1426: 			&awarddetail_to_awarded($Apache::lonhomework::results{"resource.$id.$res.awarddetail"});
 1427: 		}
 1428: 	    }
 1429: 	    if ($numawards > 0) {
 1430: 		$Apache::lonhomework::results{"resource.$id.awarded"}/=
 1431: 		    $numawards;
 1432: 	    }
 1433: 	} elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
 1434: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
 1435: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1436: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
 1437: 		$solvemsg;
 1438: 	    $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
 1439:         } elsif ( $award eq 'SUBMITTED_CREDIT' ) {
 1440:             $Apache::lonhomework::results{"resource.$id.tries"} =
 1441:                 $Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1442:             $Apache::lonhomework::results{"resource.$id.solved"} =
 1443:                 'credit_attempted';
 1444:             $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
 1445:         }  elsif ( $award eq 'ANONYMOUS_CREDIT' ) {
 1446:             $Apache::lonhomework::results{"resource.$id.tries"} =
 1447:                 $Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1448:             $Apache::lonhomework::results{"resource.$id.solved"} =
 1449:                 'credit_attempted';
 1450:             $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
 1451: 	} elsif ( $award eq 'INCORRECT' ) {
 1452: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
 1453: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1454: 	    if (&Apache::lonhomework::hide_problem_status()
 1455: 		|| $Apache::lonhomework::scantronmode) {
 1456: 		$Apache::lonhomework::results{"resource.$id.awarded"} = 0;
 1457: 	    }
 1458: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
 1459: 		'incorrect_attempted';
 1460: 	} elsif ( $award eq 'SUBMITTED' ) {
 1461: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
 1462: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1463: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
 1464: 		'ungraded_attempted';
 1465:         }  elsif ( $award eq 'ANONYMOUS' ) {
 1466:             $Apache::lonhomework::results{"resource.$id.tries"} =
 1467:                 $Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1468:             $Apache::lonhomework::results{"resource.$id.solved"} =
 1469:                 'ungraded_attempted';
 1470: 	} elsif ( $award eq 'DRAFT' ) {
 1471: 	    $Apache::lonhomework::results{"resource.$id.solved"} = '';
 1472: 	} elsif ( $award eq 'NO_RESPONSE' ) {
 1473: 	    #no real response so delete any data that got stored
 1474: 	    &removealldata($id);
 1475: 	    return '';
 1476: 	} else {
 1477: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
 1478: 		'incorrect_attempted';
 1479: 	    if (&Apache::lonhomework::show_no_problem_status()
 1480: 		|| $Apache::lonhomework::scantronmode) {
 1481: 		$Apache::lonhomework::results{"resource.$id.tries"} =
 1482: 		    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
 1483: 		$Apache::lonhomework::results{"resource.$id.awarded"} = 0;
 1484: 	    }
 1485: 
 1486: 	    if (&Apache::lonhomework::show_some_problem_status()) {
 1487: 		# clear out the awarded if they had gotten it wrong/right
 1488: 		# and are now in an error mode	
 1489: 		$Apache::lonhomework::results{"resource.$id.awarded"} = '';
 1490: 	    }
 1491: 	}
 1492: 	if (defined($msg)) {
 1493: 	    $Apache::lonhomework::results{"resource.$id.awardmsg"} = $msg;
 1494: 	}
 1495: 	# did either of the overall awards chage? If so ignore the 
 1496: 	# previous check
 1497: 	if (($Apache::lonhomework::results{"resource.$id.awarded"} eq
 1498: 	     $Apache::lonhomework::history{"resource.$id.awarded"}) &&
 1499: 	    ($Apache::lonhomework::results{"resource.$id.solved"} eq
 1500: 	     $Apache::lonhomework::history{"resource.$id.solved"})) {
 1501: 	    # check if this was a previous submission if it was delete the
 1502: 	    # unneeded data and update the previously_used attribute
 1503: 	    if ( $previously_used eq 'PREVIOUSLY_USED') {
 1504: 		if (&Apache::lonhomework::show_problem_status()) {
 1505: 		    delete($Apache::lonhomework::results{"resource.$id.tries"});
 1506: 		    $Apache::lonhomework::results{"resource.$id.previous"} = '1';
 1507: 		}
 1508: 	    } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
 1509: 		#delete all data as they student didn't do anything, but save
 1510: 		#the list of collaborators.
 1511: 		&removealldata($id);
 1512: 		#and since they didn't do anything we were never here
 1513: 		return '';
 1514: 	    } else {
 1515: 		$Apache::lonhomework::results{"resource.$id.previous"} = '0';
 1516: 	    }
 1517: 	}
 1518:     } elsif ( $Apache::lonhomework::history{"resource.$id.awarded"} == 1 ) {
 1519: 	#delete all data as they student already has it correct
 1520: 	&removealldata($id);
 1521: 	#and since they didn't do anything we were never here
 1522: 	return '';
 1523:     }
 1524:     $Apache::lonhomework::results{"resource.$id.award"} = $award;
 1525:     if ($award eq 'SUBMITTED') {
 1526: 	&Apache::response::add_to_gradingqueue();
 1527:     }
 1528:     $Apache::lonhomework::results{"resource.$id.type"} = $Apache::lonhomework::type;
 1529:     $Apache::lonhomework::results{"resource.$id.duedate"} = &Apache::lonnet::EXT("resource.$id.duedate");
 1530:     $Apache::lonhomework::results{"resource.$id.hinttries"} = &Apache::lonnet::EXT("resource.$id.hinttries");
 1531:     $Apache::lonhomework::results{"resource.$id.version"} = &Apache::lonnet::usedversion();
 1532:     $Apache::lonhomework::results{"resource.$id.maxtries"} = &Apache::lonnet::EXT("resource.$id.maxtries");
 1533: }
 1534: 
 1535: sub find_which_previous {
 1536:     my ($version) = @_;
 1537:     my $part = $Apache::inputtags::part;
 1538:     my (@previous_version);
 1539:     foreach my $resp (@Apache::inputtags::response) {
 1540: 	my $key = "$version:resource.$part.$resp.submission";
 1541: 	my $submission = $Apache::lonhomework::history{$key};
 1542: 	my %previous = &Apache::response::check_for_previous($submission,
 1543: 							     $part,$resp,
 1544: 							     $version);
 1545: 	push(@previous_version,$previous{'version'});
 1546:     }
 1547:     return &previous_match(\@previous_version,
 1548: 			   scalar(@Apache::inputtags::response));
 1549: }
 1550: 
 1551: sub previous_match {
 1552:     my ($previous_array,$count) = @_;
 1553:     my $match = 0;
 1554:     my @matches;
 1555:     foreach my $versionar (@$previous_array) {
 1556: 	foreach my $version (@$versionar) {
 1557: 	    $matches[$version]++;
 1558: 	}
 1559:     }
 1560:     my $which=0;
 1561:     foreach my $elem (@matches) {
 1562: 	if ($elem eq $count) {
 1563: 	    $match=1;
 1564: 	    last;
 1565: 	}
 1566: 	$which++;
 1567:     }
 1568:     return ($match,$which);
 1569: }
 1570: 
 1571: sub grade {
 1572:     my ($target) = @_;
 1573:     my $id = $Apache::inputtags::part;
 1574:     my $response='';
 1575:     if ( defined $env{'form.submitted'}) {
 1576: 	my (@awards,@msgs);
 1577: 	foreach $response (@Apache::inputtags::response) {
 1578: 	    &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
 1579: 	    my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
 1580: 	    &Apache::lonxml::debug("keeping $value from $response for $id");
 1581: 	    push (@awards,$value);
 1582: 	    $value=$Apache::lonhomework::results{"resource.$id.$response.awardmsg"};
 1583: 	    &Apache::lonxml::debug("got message $value from $response for $id");
 1584: 	    push (@msgs,$value);
 1585: 	}
 1586: 	my ($finalaward,$msg) = 
 1587: 	    &finalizeawards(\@awards,\@msgs,undef,undef,
 1588: 			    $Apache::lonhomework::scantronmode);
 1589: 	my $previously_used;
 1590: 	if ( $#Apache::inputtags::previous eq $#awards ) {
 1591: 	    my ($match) =
 1592: 		&previous_match(\@Apache::inputtags::previous_version,
 1593: 				scalar(@Apache::inputtags::response));
 1594: 
 1595: 	    if ($match) {
 1596: 		$previously_used = 'PREVIOUSLY_LAST';
 1597: 		foreach my $value (@Apache::inputtags::previous) {
 1598: 		    if ($value eq 'PREVIOUSLY_USED' ) {
 1599: 			$previously_used = $value;
 1600: 			last;
 1601: 		    }
 1602: 		}
 1603: 	    }
 1604: 	}
 1605: 	&Apache::lonxml::debug("final award $finalaward, $previously_used, message $msg");
 1606: 	&setgradedata($finalaward,$msg,$id,$previously_used);
 1607:     }
 1608:     return '';
 1609: }
 1610: 
 1611: sub get_grade_messages {
 1612:     my ($id,$prefix,$target,$status,$nocorrect,$tdclass) = @_;
 1613: # nocorrect suppresses "Computer's answer now shown above"
 1614:     my ($message,$latemessage,$trystr,$previousmsg);
 1615:     my $showbutton = 1;
 1616: 
 1617:     my $award = $Apache::lonhomework::history{"$prefix.award"};
 1618:     my $awarded = $Apache::lonhomework::history{"$prefix.awarded"};
 1619:     my $solved = $Apache::lonhomework::history{"$prefix.solved"};
 1620:     my $previous = $Apache::lonhomework::history{"$prefix.previous"};
 1621:     my $awardmsg = $Apache::lonhomework::history{"$prefix.awardmsg"};
 1622:     &Apache::lonxml::debug("Found Award |$award|$solved|$awardmsg");
 1623:     if ( $award ne '' || $solved ne '' || $status eq 'SHOW_ANSWER') {
 1624: 	&Apache::lonxml::debug('Getting message');
 1625: 	($showbutton,my $css_class,$message,$previousmsg) =
 1626: 	    &decideoutput($award,$awarded,$awardmsg,$solved,$previous,
 1627: 			  $target,(($status eq 'CAN_ANSWER') || $nocorrect),$tdclass);
 1628: 	if ($target eq 'tex') {
 1629: 	    $message='\vskip 2 mm '.$message.' ';
 1630: 	} else {
 1631: 	    $message="<td class=\"$tdclass $css_class\">$message</td>";
 1632: 	    if ($previousmsg) {
 1633: 		$previousmsg="<td class=\"$tdclass LC_answer_previous\">$previousmsg</td>";
 1634: 	    }
 1635: 	}
 1636:     }
 1637:     my $tries = $Apache::lonhomework::history{"$prefix.tries"};
 1638:     my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
 1639:     &Apache::lonxml::debug("got maxtries of :$maxtries:");
 1640:     #if tries are set to negative turn off the Tries/Button and messages
 1641:     if (defined($maxtries) && $maxtries < 0) { return ''; }
 1642:     if ( $tries eq '' ) { $tries = '0'; }
 1643:     if ( $maxtries eq '' ) { $maxtries = '2'; } 
 1644:     if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
 1645:     my $tries_text= &get_tries_text();
 1646:     if ($showbutton) {
 1647: 	if ($target eq 'tex') {
 1648: 	    if ($env{'request.state'} ne "construct"
 1649: 		&& $Apache::lonhomework::type ne 'exam'
 1650: 		&& $env{'form.suppress_tries'} ne 'yes') {
 1651: 		$trystr ='{\vskip 1 mm \small '
 1652:                         .&mt('[_1]'.$tries_text.'[_2] [_3]'
 1653: 				,'\textit{','}',$tries.'/'.$maxtries ) 
 1654:                         .'} \vskip 2 mm';
 1655: 	    } else {
 1656: 		$trystr = '\vskip 0 mm ';
 1657: 	    }
 1658: 	} else {
 1659: 	    my $trial =$tries;
 1660: 	    if ($Apache::lonhomework::parsing_a_task) {
 1661: 	    } elsif($env{'request.state'} ne 'construct') {
 1662: 		$trial.="/".&Apache::lonhtmlcommon::direct_parm_link($maxtries,$env{'request.symb'},'maxtries',$id,$target);
 1663: 	    } else {
 1664: 		if (defined($Apache::inputtags::params{'maxtries'})) {
 1665: 		    $trial.="/".$Apache::inputtags::params{'maxtries'};
 1666: 		}
 1667: 	    }
 1668: 	    $trystr = '<td class="'.$tdclass.'"><span class="LC_nobreak">'.&mt($tries_text.' [_1]',$trial).'</span></td>';
 1669: 	}
 1670:     }
 1671: 
 1672:     if ($Apache::lonhomework::history{"$prefix.afterduedate"}) {
 1673: 	#last submissions was after due date
 1674: 	$latemessage=&mt(' The last submission was after the Due Date ');;
 1675: 	if ($target eq 'web') {
 1676: 	    $latemessage='<td class="'.$tdclass.' LC_answer_late">'.$latemessage.'</td>';
 1677: 	}
 1678:     }
 1679:     return ($previousmsg,$latemessage,$message,$trystr,$showbutton);
 1680: }
 1681: 
 1682: sub gradestatus {
 1683:     my ($id,$target,$no_previous) = @_;
 1684:     my $showbutton = 1;
 1685:     my $message = '';
 1686:     my $latemessage = '';
 1687:     my $trystr='';
 1688:     my $button='';
 1689:     my $previousmsg='';
 1690:     my $tdclass='';
 1691: 
 1692:     my $status = $Apache::inputtags::status['-1'];
 1693:     &Apache::lonxml::debug("gradestatus has :$status:");
 1694:     if ( $status ne 'CLOSED' 
 1695: 	 && $status ne 'UNAVAILABLE' 
 1696: 	 && $status ne 'INVALID_ACCESS' 
 1697: 	 && $status ne 'NEEDS_CHECKIN' 
 1698: 	 && $status ne 'NOT_IN_A_SLOT'
 1699:          && $status ne 'RESERVABLE'
 1700:          && $status ne 'RESERVABLE_LATER'
 1701:          && $status ne 'NOTRESERVABLE') {
 1702: 
 1703: 	if ($status eq 'SHOW_ANSWER') {
 1704:             $showbutton = 0;
 1705:         }
 1706: 
 1707:         unless (($status eq 'SHOW_ANSWER') || ($status eq 'CANNOT_ANSWER')) {
 1708:             if ($target ne 'tex') {
 1709:                 $tdclass = 'LC_status_submit_'.$id;
 1710:             }
 1711:         }
 1712: 
 1713: 	($previousmsg,$latemessage,$message,$trystr) =
 1714: 	    &get_grade_messages($id,"resource.$id",$target,$status,
 1715: 				$showbutton,$tdclass);
 1716: 	if ($status eq 'CANNOT_ANSWER') {
 1717: 	    $showbutton = 0;
 1718: 	}
 1719: 	if ( $status eq 'SHOW_ANSWER') {
 1720: 	    undef($previousmsg);
 1721: 	}
 1722: 	if ( $showbutton ) {
 1723: 	    if ($target ne 'tex') {
 1724: 		$button = 
 1725:             '<input onmouseup="javascript:setSubmittedPart(\''.$id.'\');this.form.action+=\'#'.&escape($id).'\';"
 1726:                     type="submit" name="submit_'.$id.'" id="submit_'.$id.'" class="LC_hwk_submit"
 1727:                     value="'.&mt('Submit Answer').'" />&nbsp;'.
 1728:                     '<div id="msg_submit_'.$id.'" style="display:none">'.
 1729:                     &mt('Processing your submission ...').'</div>';
 1730: 	    }
 1731: 	}
 1732: 
 1733:     }
 1734:     my $output= $previousmsg.$latemessage.$message.$trystr;
 1735:     if ($output =~ /^\s*$/) {
 1736: 	return $button;
 1737:     } else {
 1738: 	if ($target eq 'tex') {
 1739: 	    return $button.' \vskip 0 mm '.$output.' ';
 1740: 	} else {
 1741: 	    $output =
 1742: 		'<table><tr><td>'.$button.'</td>'.$output;
 1743: 	    if (!$no_previous) {
 1744: 		$output.='<td class="'.$tdclass.'">'.&previous_tries($id,$target).'</td>';
 1745: 	    }
 1746: 	    $output.= '</tr></table>';
 1747: 	    return $output;
 1748: 	}
 1749:     }
 1750: }
 1751: 
 1752: sub previous_tries {
 1753:     my ($id,$target) = @_;
 1754:     my $output;
 1755:     my $status = $Apache::inputtags::status['-1'];
 1756: 
 1757:     my $count;
 1758:     my %count_lookup;
 1759:     my ($lastrndseed,$lasttype);
 1760:     my $numstamps = 0;
 1761: 
 1762:     foreach my $i (1..$Apache::lonhomework::history{'version'}) {
 1763: 	my $prefix = $i.":resource.$id";
 1764:         my $is_anon;
 1765:         my $curr_type = $Apache::lonhomework::history{"$prefix.type"};    
 1766:         if (defined($env{'form.grade_symb'})) {
 1767:             if (($curr_type eq 'anonsurvey') || ($curr_type eq 'anonsurveycred')) {
 1768:                 $is_anon = 1;
 1769:             }
 1770:         }
 1771: 	next if (!exists($Apache::lonhomework::history{"$prefix.award"}));
 1772: 	$count++;
 1773: 	$count_lookup{$i} = $count;
 1774:         my $curr_rndseed = $Apache::lonhomework::history{"$prefix.rndseed"};
 1775: 	my ($previousmsg,$latemessage,$message,$trystr);
 1776: 
 1777: 	($previousmsg,$latemessage,$message,$trystr) =
 1778: 	    &get_grade_messages($id,"$prefix",$target,$status);
 1779: 
 1780: 	if ($previousmsg ne '') {
 1781: 	    my ($match,$which) = &find_which_previous($i);
 1782: 	    $message=$previousmsg;
 1783: 	    my $previous = $count_lookup{$which};
 1784: 	    $message =~ s{(</td>)}{ as submission \# $previous $1};
 1785: 	} elsif ($Apache::lonhomework::history{"$prefix.tries"}) {
 1786: 	    if (!(&Apache::lonhomework::hide_problem_status()
 1787: 		  && $Apache::inputtags::status[-1] ne 'SHOW_ANSWER')
 1788: 		&& $Apache::lonhomework::history{"$prefix.solved"} =~/^correct/
 1789: 		) {
 1790: 		
 1791:                 my $txt_correct = &mt('Correct');
 1792:                 my $awarded = $Apache::lonhomework::history{"$prefix.awarded"};
 1793:                 if ($awarded < 1 && $awarded > 0) {
 1794:                     $txt_correct=&mt('Partially Correct');
 1795:                 } elsif ($awarded < 1) {
 1796:                     if ($awarded eq '') {
 1797:                         $txt_correct='';
 1798:                     } else {
 1799:                         $txt_correct=&mt('Incorrect');
 1800:                     }
 1801:                 }
 1802: 		$message =~ s{(<td.*?>)(.*?)(</td>)}
 1803:                              {$1 <strong>$txt_correct</strong>. $3}s;
 1804: 	    }
 1805:             my $trystr = "(".&mt('Try [_1]',$Apache::lonhomework::history{"$prefix.tries"}).")";
 1806:             if (($curr_rndseed ne '') &&  ($lastrndseed ne '')) {
 1807:                 if (($curr_rndseed ne $lastrndseed) && 
 1808:                     (($curr_type eq 'randomizetry') || ($lasttype eq 'randomizetry'))) {
 1809:                     $trystr .= '<br /><span style="color: green; white-space: nowrap; font-style: italic; font-weight: bold; font-size: 80%;">'.&mt('New problem variation this try.').'</span>';
 1810:                 }
 1811:             } 
 1812: 	    $message =~ s{(</td>)}{ $trystr $1};
 1813: 	}
 1814: 	my ($class) = ($message =~ m{<td.*class="([^"]*)"}); #"
 1815: 	$message =~ s{(<td.*?>)}{<td>};
 1816: 	
 1817: 
 1818: 	$output .= '<tr class="'.$class.'">'.
 1819: 	           '<td align="center">'.$count.'</td>'.$message;
 1820:         if ((!$is_anon) && ($Apache::lonhomework::history{"$prefix.tries"}) &&
 1821:             ($Apache::lonhomework::history{"$prefix.award"} ne 'ASSIGNED_SCORE') &&
 1822:             ($Apache::lonhomework::history{$i.':timestamp'})) {
 1823:             $output .= '<td>'.&Apache::lonlocal::locallocaltime(
 1824:                              $Apache::lonhomework::history{$i.':timestamp'}).'</td>';
 1825:             $numstamps ++;
 1826:         } else {
 1827:             $output .= '<td></td>';
 1828:         }
 1829: 	foreach my $resid (@Apache::inputtags::response) {
 1830: 	    my $prefix = $prefix.".$resid";
 1831: 	    if (exists($Apache::lonhomework::history{"$prefix.submission"})) {
 1832: 		my $submission =
 1833: 		    $Apache::inputtags::submission_display{"$prefix.submission"};
 1834: 		if (!defined($submission)) {
 1835: 		    $submission = 
 1836: 			$Apache::lonhomework::history{"$prefix.submission"};
 1837: 		}
 1838:                 if ($is_anon) {
 1839:                     $output.='<td>'.&mt('(only shown to submitter)').'</td>';
 1840:                 } else {
 1841: 		    $output.='<td>'.$submission.'</td>';
 1842:                 }
 1843: 	    } else {
 1844: 		$output.='<td></td>';
 1845: 	    }
 1846: 	}
 1847: 	$output.=&Apache::loncommon::end_data_table_row()."\n";
 1848:         $lastrndseed = $curr_rndseed;
 1849:         $lasttype = $curr_type;
 1850:     }
 1851:     return if ($output eq '');
 1852:     my $headers = '<tr>'.
 1853:                   '<th>'.&mt('Submission #').'</th>'.
 1854:                   '<th>'.&mt('Try').'</th><th>';
 1855:     if ($numstamps) {
 1856:         $headers .= &mt('When');
 1857:     }
 1858:     $headers .= '</th>';
 1859:     my $colspan = scalar(@Apache::inputtags::response);
 1860:     if ($colspan > 1) {
 1861:         $headers .= '<th colspan="'.$colspan.'">';
 1862:     } else {
 1863:         $headers .= '<th>';
 1864:     }
 1865:     $headers .= &mt('Submitted Answer').'</th></tr>';
 1866:     $output ='<table class="LC_prior_tries">'.$headers.$output.'</table>';
 1867: 
 1868:     my $tries_text = &get_tries_text('link');
 1869:     my $prefix = $env{'form.request.prefix'};
 1870:     $prefix =~ tr{.}{_};
 1871:     my $function_name = "LONCAPA_previous_tries_".$prefix.
 1872: 	$Apache::lonxml::curdepth.'_'.$env{'form.counter'};
 1873:     my $result = &Apache::loncommon::modal_adhoc_window($function_name,420,410,$output,&mt($tries_text))."<br />";
 1874:     return $result;
 1875: }
 1876: 
 1877: sub get_tries_text {
 1878:     my ($context) = @_;
 1879:     my $tries_text;
 1880:     if ($context eq 'link') {
 1881:         $tries_text = 'Previous Tries';
 1882:     } else {
 1883:         $tries_text = 'Tries';
 1884:     }
 1885:     if ( $Apache::lonhomework::type eq 'survey' ||
 1886:          $Apache::lonhomework::type eq 'surveycred' ||
 1887:          $Apache::lonhomework::type eq 'anonsurvey' ||
 1888:          $Apache::lonhomework::type eq 'anonsurveycred' ||
 1889:          $Apache::lonhomework::parsing_a_task) {
 1890:         if ($context eq 'link') {
 1891:             $tries_text = 'Previous Submissions';
 1892:         } else {
 1893:             $tries_text = 'Submissions';
 1894:         }
 1895:     }
 1896:     return $tries_text;
 1897: }
 1898: 
 1899: sub spelling_languages {
 1900:     my %langchoices;
 1901:     foreach my $id (&Apache::loncommon::languageids()) {
 1902:         my $code = &Apache::loncommon::supportedlanguagecode($id);
 1903:         if ($code ne '') {
 1904:             $langchoices{$code} =  &Apache::loncommon::plainlanguagedescription($id);
 1905:         }
 1906:     }
 1907:     my @spelllangs = ('none');
 1908:     foreach my $code ('en','de','he','es','fr','pt','tr') {
 1909:         push(@spelllangs,[$code,$langchoices{$code}]);
 1910:     }
 1911:     return \@spelllangs;
 1912: }
 1913: 
 1914: 1;
 1915: __END__
 1916: 
 1917: =pod
 1918: 
 1919: =back
 1920: 
 1921: =cut
 1922:  

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>