File:  [LON-CAPA] / loncom / homework / inputtags.pm
Revision 1.230: download - view: text, annotated - select for diffs
Tue Sep 18 22:18:41 2007 UTC (16 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- BUG#5431
   - need to set the cubmitted part when the user clicks on the correct
     Submit Answer button (using onmouseup rather than onclick so that when
     the user presses enter the virtual click of the first submit button
     doesn't undo the preservation of which field they last typed in)

    1: # The LearningOnline Network with CAPA
    2: # input  definitons
    3: #
    4: # $Id: inputtags.pm,v 1.230 2007/09/18 22:18:41 albertel 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: package Apache::inputtags;
   29: use HTML::Entities();
   30: use strict;
   31: use Apache::loncommon;
   32: use Apache::lonlocal;
   33: use Apache::lonnet;
   34: use LONCAPA;
   35:  
   36: 
   37: BEGIN {
   38:     &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));
   39: }
   40: 
   41: #   Initializes a set of global variables used during the parse of the problem.
   42: #
   43: #  @Apache::inputtags::input        - List of current input ids.
   44: #  @Apache::inputtags::inputlist    - List of all input ids seen this problem.
   45: #  @Apache::inputtags::response     - List of all current resopnse ids.
   46: #  @Apache::inputtags::responselist - List of all response ids seen this 
   47: #                                       problem.
   48: #  @Apache::inputtags::hint         - List of all hint ids.
   49: #  @Apache::inputtags::hintlist     - List of all hint ids seen this problem.
   50: #  @Apache::inputtags::previous     - List describing if specific responseds
   51: #                                       have been used
   52: #  @Apache::inputtags::previous_version - Submission responses were used in.
   53: #  $Apache::inputtags::part         - Current part id (valid only in 
   54: #                                       <problem>)
   55: #                                     0 if not in a part.
   56: #  @Apache::inputtags::partlist     - List of part ids seen in the current
   57: #                                       <problem>
   58: #  @Apache::inputtags::status       - List of problem  statuses. First 
   59: #                                     element is the status of the <problem>
   60: #                                     the remainder are for individual <part>s.
   61: #  %Apache::inputtags::params       - Hash of defined parameters for the
   62: #                                     current response.
   63: #  @Apache::inputtags::import       - List of all ids for <import> thes get
   64: #                                     join()ed and prepended.
   65: #  @Apache::inputtags::importlist   - List of all import ids seen.
   66: #  $Apache::inputtags::response_with_no_part
   67: #                                   - Flag set true if we have seen a response
   68: #                                     that is not inside a <part>
   69: #  %Apache::inputtags::answertxt    - <*response> tags store correct
   70: #                                     answer strings for display by <textline/>
   71: #                                     in this hash.
   72: #  %Apache::inputtags::submission_display
   73: #                                   - <*response> tags store improved display
   74: #                                     of submission strings for display by part
   75: #                                     end.
   76: 
   77: sub initialize_inputtags {
   78:     @Apache::inputtags::input=();
   79:     @Apache::inputtags::inputlist=();
   80:     @Apache::inputtags::response=();
   81:     @Apache::inputtags::responselist=();
   82:     @Apache::inputtags::hint=();
   83:     @Apache::inputtags::hintlist=();
   84:     @Apache::inputtags::previous=();
   85:     @Apache::inputtags::previous_version=();
   86:     $Apache::inputtags::part='';
   87:     @Apache::inputtags::partlist=();
   88:     @Apache::inputtags::status=();
   89:     %Apache::inputtags::params=();
   90:     @Apache::inputtags::import=();
   91:     @Apache::inputtags::importlist=();
   92:     $Apache::inputtags::response_with_no_part=0;
   93:     %Apache::inputtags::answertxt=();
   94:     %Apache::inputtags::submission_display=();
   95: }
   96: 
   97: sub check_for_duplicate_ids {
   98:     my %check;
   99:     foreach my $id (@Apache::inputtags::partlist,
  100: 		    @Apache::inputtags::responselist,
  101: 		    @Apache::inputtags::hintlist,
  102: 		    @Apache::inputtags::importlist) {
  103: 	$check{$id}++;
  104:     }
  105:     my @duplicates;
  106:     foreach my $id (sort(keys(%check))) {
  107: 	if ($check{$id} > 1) {
  108: 	    push(@duplicates,$id);
  109: 	}
  110:     }
  111:     if (@duplicates) {
  112: 	&Apache::lonxml::error("Duplicated ids found, problem will operate incorrectly. Duplicated ids seen: ",join(', ',@duplicates));
  113:     }
  114: }
  115: 
  116: sub start_input {
  117:     my ($parstack,$safeeval)=@_;
  118:     my $id = &Apache::lonxml::get_id($parstack,$safeeval);
  119:     push (@Apache::inputtags::input,$id);
  120:     push (@Apache::inputtags::inputlist,$id);
  121:     return $id;
  122: }
  123: 
  124: sub end_input {
  125:     pop @Apache::inputtags::input;
  126:     return '';
  127: }
  128: 
  129: sub addchars {
  130:     my ($fieldid,$addchars)=@_;
  131:     my $output='';
  132:     foreach (split(/\,/,$addchars)) {
  133: 	$output.='<a href="javascript:void(document.forms.lonhomework.'.
  134: 	    $fieldid.'.value+=\''.$_.'\')">'.$_.'</a> ';
  135:     }
  136:     return $output;
  137: }
  138: 
  139: sub start_textfield {
  140:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  141:     my $result = "";
  142:     my $id = &start_input($parstack,$safeeval);
  143:     my $resid=$Apache::inputtags::response[-1];
  144:     if ($target eq 'web') {
  145: 	$Apache::lonxml::evaluate--;
  146: 	my $partid=$Apache::inputtags::part;
  147: 	my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"},'<>&"');
  148: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  149: 	    my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
  150: 	    if ( $cols eq '') { $cols = 80; }
  151: 	    my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
  152: 	    if ( $rows eq '') { $rows = 16; }
  153: 	    my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
  154: 	    $result='';
  155: 	    if ($addchars) {
  156: 		$result.=&addchars('HWVAL_'.$resid,$addchars);
  157: 	    }
  158: 	    &Apache::lonhtmlcommon::add_htmlareafields('HWVAL_'.$resid);
  159: 	    $result.= '<textarea wrap="hard" name="HWVAL_'.$resid.'" id="HWVAL_'.$resid.'" '.
  160: 		"rows=\"$rows\" cols=\"$cols\">".$oldresponse;
  161: 	    if ($oldresponse ne '') {
  162: 
  163: 		#get rid of any startup text if the user has already responded
  164: 		&Apache::lonxml::get_all_text("/textfield",$parser,$style);
  165: 	    }
  166: 	} else {
  167: 	    #show past answer in the essayresponse case
  168: 	    if ($oldresponse =~ /\S/
  169: 		&& &Apache::londefdef::is_inside_of($tagstack,
  170: 						    'essayresponse') ) {
  171: 		$result='<table class="LC_pastsubmission"><tr><td>'.
  172: 		    $oldresponse.'</td></tr></table>';
  173: 	    }
  174: 	    #get rid of any startup text
  175: 	    &Apache::lonxml::get_all_text("/textfield",$parser,$style);
  176: 	}
  177:     } elsif ($target eq 'grade') {
  178: 	my $seedtext=&Apache::lonxml::get_all_text("/textfield",$parser,
  179: 						   $style);
  180: 	if ($seedtext eq $env{'form.HWVAL_'.$resid}) {
  181: 	    # if the seed text is still there it wasn't a real submission
  182: 	    $env{'form.HWVAL_'.$resid}='';
  183: 	}
  184:     } elsif ($target eq 'edit') {
  185: 	$result.=&Apache::edit::tag_start($target,$token);
  186: 	$result.=&Apache::edit::text_arg('Rows:','rows',$token,4);
  187: 	$result.=&Apache::edit::text_arg('Columns:','cols',$token,4);
  188: 	$result.=&Apache::edit::text_arg
  189: 	    ('Click-On Texts (comma sep):','addchars',$token,10);
  190: 	my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser,
  191: 						   $style);
  192: 	$result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);
  193:     } elsif ($target eq 'modified') {
  194: 	my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  195: 						     $safeeval,'rows','cols',
  196: 						     'addchars');
  197: 	if ($constructtag) {
  198: 	    $result = &Apache::edit::rebuild_tag($token);
  199: 	} else {
  200: 	    $result=$token->[4];
  201: 	}
  202: 	$result.=&Apache::edit::modifiedfield("/textfield",$parser);
  203:     } elsif ($target eq 'tex') {
  204: 	my $number_of_lines = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
  205: 	my $width_of_box = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
  206: 	if ($$tagstack[-2] eq 'essayresponse' and $Apache::lonhomework::type eq 'exam') {
  207: 	    $result = '\fbox{\fbox{\parbox{\textwidth-5mm}{';
  208: 	    for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
  209: 	    $result.='\strut \\\\\strut \\\\\strut \\\\\strut \\\\}}}';
  210: 	} else {
  211: 	    my $TeXwidth=$width_of_box/80;
  212: 	    $result = '\vskip 1 mm \fbox{\fbox{\parbox{'.$TeXwidth.'\textwidth-5mm}{';
  213: 	    for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
  214: 	    $result.='}}}\vskip 2 mm ';
  215: 	}
  216:     }
  217:     return $result;
  218: }
  219: 
  220: sub end_textfield {
  221:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  222:     my $result;
  223:     if ($target eq 'web') {
  224: 	$Apache::lonxml::evaluate++;
  225: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  226: 	    return "</textarea>";
  227: 	}
  228:     } elsif ($target eq 'edit') {
  229: 	$result=&Apache::edit::end_table();
  230:     }
  231:     &end_input;
  232:     return $result;
  233: }
  234: 
  235: sub exam_score_line {
  236:     my ($target) = @_;
  237: 
  238:     my $result;
  239:     if ($target eq 'tex') {
  240: 	my $repetition = &Apache::response::repetition();
  241: 	$result.='\begin{enumerate}';
  242: 	if ($env{'request.state'} eq "construct" ) {$result.='\item[\strut]';}
  243: 	foreach my $i (0..$repetition-1) {
  244: 	    $result.='\item[\textbf{'.
  245: 		($Apache::lonxml::counter+$i).
  246: 		'}.]\textit{Leave blank on scoring form}\vskip 0 mm';
  247: 	}
  248: 	$result.= '\end{enumerate}';
  249:     }
  250: 
  251:     return $result;
  252: }
  253: 
  254: sub exam_box {
  255:     my ($target) = @_;
  256:     my $result;
  257: 
  258:     if ($target eq 'tex') {
  259: 	$result .= '\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';
  260: 	$result .= &exam_score_line($target);
  261:     } elsif ($target eq 'web') {
  262: 	my $id=$Apache::inputtags::response[-1];
  263: 	$result.= '<br /><br />
  264:                    <textarea name="HWVAL_'.$id.'" rows="4" cols="50">
  265:                    </textarea> <br /><br />';
  266:     }
  267:     return $result;
  268: }
  269: 
  270: sub needs_exam_box {
  271:     my ($tagstack) = @_;
  272:     my @tags = ('formularesponse',
  273: 		'stringresponse',
  274: 		'reactionresponse',
  275: 		'organicresponse',
  276: 		);
  277: 
  278:     foreach my $tag (@tags) {
  279: 	if (grep(/\Q$tag\E/,@$tagstack)) {
  280: 	    return 1;
  281: 	}
  282:     }
  283:     return 0;
  284: }
  285: 
  286: sub start_textline {
  287:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  288:     my $result = "";
  289:     my $input_id = &start_input($parstack,$safeeval);
  290:     if ($target eq 'web') {
  291: 	$Apache::lonxml::evaluate--;
  292: 	my $partid=$Apache::inputtags::part;
  293: 	my $id=$Apache::inputtags::response[-1];
  294: 	if (!&Apache::response::show_answer()) {
  295: 	    my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
  296: 	    my $maxlength;
  297: 	    if ($size eq '') { $size=20; } else {
  298: 		if ($size < 20) {
  299: 		    $maxlength = ' maxlength="'.$size.'"';
  300: 		}
  301: 	    }
  302: 	    my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
  303: 	    &Apache::lonxml::debug("oldresponse $oldresponse is ".ref($oldresponse));
  304: 
  305: 	    if (ref($oldresponse) eq 'ARRAY') {
  306: 		$oldresponse = $oldresponse->[$#Apache::inputtags::inputlist];
  307: 	    }
  308: 	    $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"');
  309: 
  310: 	    if ($Apache::lonhomework::type ne 'exam') {
  311: 		my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
  312: 		$result='';
  313: 		if ($addchars) {
  314: 		    $result.=&addchars('HWVAL_'.$id,$addchars);
  315: 		}
  316: 		my $readonly=&Apache::lonxml::get_param('readonly',$parstack,
  317: 							$safeeval);
  318: 		if (lc($readonly) eq 'yes' 
  319: 		    || $Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
  320: 		    $readonly=' readonly="readonly" ';
  321: 		} else {
  322: 		    $readonly='';
  323: 		}
  324: 		my $name = 'HWVAL_'.$id;
  325: 		if ($Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
  326: 		    $name = "none";
  327: 		}
  328: 		$result.= '<input onkeydown="javascript:setSubmittedPart(\''.$partid.'\');" type="text" '.$readonly.' name="'.$name.'" value="'.
  329: 		    $oldresponse.'" size="'.$size.'"'.$maxlength.' />';
  330: 	    }
  331: 	    if ($Apache::lonhomework::type eq 'exam'
  332: 		&& &needs_exam_box($tagstack)) {
  333: 		$result.=&exam_box($target);
  334: 	    }
  335: 	} else {
  336: 	    #right or wrong don't show what was last typed in.
  337: 	    my $count = scalar(@Apache::inputtags::inputlist)-1;
  338: 	    $result='<b>'.$Apache::inputtags::answertxt{$id}[$count].'</b>';
  339: 	    #$result='';
  340: 	}
  341:     } elsif ($target eq 'edit') {
  342: 	$result=&Apache::edit::tag_start($target,$token);
  343: 	$result.=&Apache::edit::text_arg('Size:','size',$token,'5').
  344: 	    &Apache::edit::text_arg('Click-On Texts (comma sep):',
  345: 				    'addchars',$token,10);
  346:         $result.=&Apache::edit::select_arg('Readonly:','readonly',
  347: 					   ['no','yes'],$token);
  348: 	$result.=&Apache::edit::end_row();
  349: 	$result.=&Apache::edit::end_table();
  350:     } elsif ($target eq 'modified') {
  351: 	my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  352: 						     $safeeval,'size',
  353: 						     'addchars','readonly');
  354: 	if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
  355:     } elsif ($target eq 'tex' 
  356: 	     && $Apache::lonhomework::type ne 'exam') {
  357: 	my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
  358: 	if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';}
  359: 	$result='\framebox['.$size.'][s]{\tiny\strut}';
  360: 
  361:     } elsif ($target eq 'tex' 
  362: 	     && $Apache::lonhomework::type eq 'exam'
  363: 	     && &needs_exam_box($tagstack)) {
  364: 	$result.=&exam_box($target);
  365:     }
  366:     return $result;
  367: }
  368: 
  369: sub end_textline {
  370:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  371:     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  372:     elsif ($target eq 'edit') { return ('','no'); }
  373:     &end_input();
  374:     return "";
  375: }
  376: 
  377: sub start_hiddenline {
  378:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  379:     my $result = "";
  380:     my $input_id = &start_input($parstack,$safeeval);
  381:     if ($target eq 'web') {
  382: 	$Apache::lonxml::evaluate--;
  383: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  384: 	    my $partid=$Apache::inputtags::part;
  385: 	    my $id=$Apache::inputtags::response[-1];
  386: 	    my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
  387: 	    if (ref($oldresponse) eq 'ARRAY') {
  388: 		$oldresponse = $oldresponse->[$#Apache::inputtags::inputlist];
  389: 	    }
  390: 	    $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"');
  391: 
  392: 	    if ($Apache::lonhomework::type ne 'exam') {
  393: 		$result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.
  394: 		    $oldresponse.'" />';
  395: 	    }
  396: 	}
  397:     } elsif ($target eq 'edit') {
  398: 	$result=&Apache::edit::tag_start($target,$token);
  399: 	$result.=&Apache::edit::end_table;
  400:     }
  401: 
  402:     if ( ($target eq 'web' || $target eq 'tex')
  403: 	 && $Apache::lonhomework::type eq 'exam'
  404: 	 && &needs_exam_box($tagstack)) {
  405: 	$result.=&exam_box($target);
  406:     }
  407:     return $result;
  408: }
  409: 
  410: sub end_hiddenline {
  411:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  412:     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  413:     elsif ($target eq 'edit') { return ('','no'); }
  414:     &end_input();
  415:     return "";
  416: }
  417: 
  418: # $part -> partid
  419: # $id -> responseid
  420: # $uploadefiletypes -> comma seperated list of extensions allowed or * for any
  421: # $which -> 'uploadedonly'  -> only newly uploaded files
  422: #           'portfolioonly' -> only allow files from portfolio
  423: #           'both' -> allow files from either location
  424: # $extratext -> additional text to go between the link and the input box
  425: # returns a table row <tr> 
  426: sub file_selector {
  427:     my ($part,$id,$uploadedfiletypes,$which,$extratext)=@_;
  428:     if (!$uploadedfiletypes) { return ''; }
  429: 
  430:     my $jspart=$part;
  431:     $jspart=~s/\./_/g;
  432: 
  433:     my $result;
  434:     
  435:     $result.='<tr><td>';
  436:     if ($uploadedfiletypes ne '*') {
  437: 	$result.=
  438: 	    &mt('Allowed filetypes: <b>[_1]</b>',$uploadedfiletypes).'<br />';
  439:     }
  440:     if ($which eq 'uploadonly' || $which eq 'both') { 
  441: 	$result.=&mt('Submit a file: (only one file can be uploaded)').
  442: 	    ' <br /><input type="file" size="50" name="HWFILE'.
  443: 	    $jspart.'_'.$id.'" /><br />';
  444: 	$result .= &show_past_file_submission($part,$id);
  445:     }
  446:     if ( $which eq 'both') { 
  447: 	$result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';
  448:     }
  449:     if ($which eq 'portfolioonly' || $which eq 'both') { 
  450: 	$result.=$extratext.'<a href='."'".'javascript:void(window.open("/adm/portfolio?mode=selectfile&amp;fieldname='.$env{'form.request.prefix'}.'HWPORT'.$jspart.'_'.$id.'","cat","height=600,width=800,scrollbars=1,resizable=1,menubar=2,location=1"))'."'".'>'.
  451: 	    &mt('Select Portfolio Files').'</a><br />'.
  452: 	    '<input type="text" size="50" name="HWPORT'.$jspart.'_'.$id.'" value="" />'.
  453: 	    '<br />';
  454: 	$result .= &show_past_portfile_submission($part,$id);
  455: 
  456:     }
  457:     $result.='</td></tr>'; 
  458:     return $result;
  459: }
  460: 
  461: sub show_past_file_submission {
  462:     my ($part,$id) = @_;
  463:     my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"');
  464: 
  465:     return if (!$uploadedfile);
  466: 
  467:     my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
  468:     &Apache::lonxml::extlink($url);
  469:     &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);
  470:     my $icon=&Apache::loncommon::icon($url);
  471:     my $curfile='<a href="'.$url.'"><img src="'.$icon.
  472: 	'" border="0" />'.$uploadedfile.'</a>';
  473:     return &mt('Currently submitted: <tt>[_1]</tt>',$curfile);
  474: 
  475: }
  476: 
  477: sub show_past_portfile_submission {
  478:     my ($part,$id) = @_;
  479:     if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}!~/[^\s]/){
  480: 	return;
  481:     }
  482:     my (@file_list,@bad_file_list);
  483:     foreach my $file (split(/\s*,\s*/,&unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) {
  484: 	my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser();
  485: 	my $url="/uploaded/$domain/$user/portfolio$file";
  486: 	my $icon=&Apache::loncommon::icon($url);
  487: 	push(@file_list,'<a href="'.$url.'"><img src="'.$icon.
  488: 	     '" border="0" />'.$file.'</a>');
  489: 	if (! &Apache::lonnet::stat_file($url)) {
  490: 	    &Apache::lonnet::logthis("bad file is $url");
  491: 	    push(@bad_file_list,'<a href="'.$url.'"><img src="'.$icon.
  492: 		 '" border="0" />'.$file.'</a>');
  493: 	}
  494:     }
  495:     my $files = '<span class="LC_filename">'.
  496: 	join('</span>, <span class="LC_filename">',@file_list).
  497: 	'</span>';
  498:     my $result = &mt("Portfolio files previously selected: [_1]",$files);
  499:     if (@bad_file_list) {
  500: 	my $bad_files = '<span class="LC_filename">'.
  501: 	    join('</span>, <span class="LC_filename">',@bad_file_list).
  502: 	    '</span>';
  503: 	$result.='<br />'.&mt('<span class="LC_error">These file(s) don\'t exist:</span> [_1]',$bad_files);
  504:     }
  505:     return $result;
  506: 
  507: }
  508: 
  509: sub valid_award {
  510:     my ($award) =@_;
  511:     foreach my $possibleaward ('EXTRA_ANSWER','MISSING_ANSWER', 'ERROR',
  512: 			       'NO_RESPONSE',
  513: 			       'TOO_LONG', 'UNIT_INVALID_INSTRUCTOR',
  514: 			       'UNIT_INVALID_STUDENT', 'UNIT_IRRECONCIBLE',
  515: 			       'UNIT_FAIL', 'NO_UNIT',
  516: 			       'UNIT_NOTNEEDED', 'WANTED_NUMERIC',
  517: 			       'BAD_FORMULA', 'SIG_FAIL', 'INCORRECT', 
  518: 			       'MISORDERED_RANK', 'INVALID_FILETYPE',
  519: 			       'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
  520: 			       'APPROX_ANS', 'EXACT_ANS','COMMA_FAIL') {
  521: 	if ($award eq $possibleaward) { return 1; }
  522:     }
  523:     return 0;
  524: }
  525: 
  526: {
  527:     my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',
  528: 		  'TOO_LONG',
  529: 		  'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT',
  530: 		  'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT',
  531: 		  'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA',
  532: 		  'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK',
  533: 		  'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
  534: 		  'APPROX_ANS', 'EXACT_ANS');
  535:     my $i=0;
  536:     my %fwd_awards = map { ($_,$i++) } @awards;
  537:     my $max=scalar(@awards);
  538:     @awards=reverse(@awards);
  539:     $i=0;
  540:     my %rev_awards = map { ($_,$i++) } @awards;
  541: 
  542: sub finalizeawards {
  543:     my ($awardref,$msgref,$nameref,$reverse)=@_;
  544:     my $result;
  545:     if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
  546:     if ($result eq '' ) {
  547: 	my $blankcount;
  548: 	foreach my $award (@$awardref) {
  549: 	    if ($award eq '') {
  550: 		$result='MISSING_ANSWER';
  551: 		$blankcount++;
  552: 	    }
  553: 	}
  554: 	if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; }
  555:     }
  556:     if (defined($result)) { return ($result); }
  557: 
  558:     # these awards are ordered from most important error through best correct
  559:     my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ;
  560: 
  561:     my $best = $max;
  562:     my $j=0;
  563:     my $which;
  564:     foreach my $award (@$awardref) {
  565: 	if ($awards->{$award} < $best) {
  566: 	    $best  = $awards->{$award};
  567: 	    $which = $j;
  568: 	}
  569: 	$j++;
  570:     }
  571:     if (defined($which)) {
  572: 	if (ref($nameref)) {
  573: 	    return ($$awardref[$which],$$msgref[$which],$$nameref[$which]);
  574: 	} else {
  575: 	    return ($$awardref[$which],$$msgref[$which]);
  576: 	}
  577:     }
  578:     return ('ERROR',undef);
  579: }
  580: }
  581: 
  582: sub decideoutput {
  583:     my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_;
  584:     my $message='';
  585:     my $button=0;
  586:     my $previousmsg;
  587:     my $css_class='orange';
  588:     my $added_computer_text=0;
  589:     my %possible_class =
  590: 	( 'correct'         => 'LC_answer_correct',
  591: 	  'charged_try'     => 'LC_answer_charged_try',
  592: 	  'not_charged_try' => 'LC_answer_not_charged_try',
  593: 	  'no_grade'        => 'LC_answer_no_grade',
  594: 	  'no_message'      => 'LC_no_message',
  595: 	  );
  596: 
  597:     my $part = $Apache::inputtags::part;
  598:     my $handgrade = 
  599: 	('yes' eq lc(&Apache::lonnet::EXT("resource.$part.handgrade")));
  600:     
  601:     my $computer = ($handgrade)? ''
  602: 	                       : " ".&mt("Computer's answer now shown above.");
  603:     &Apache::lonxml::debug("handgrade has :$handgrade:");
  604: 
  605:     if ($previous) { $previousmsg=&mt('You have entered that answer before'); }
  606:     
  607:     if ($solved =~ /^correct/) {
  608:         $css_class=$possible_class{'correct'};
  609: 	$message=&mt('You are correct.');
  610: 	if ($awarded < 1 && $awarded > 0) {
  611: 	    $message=&mt('You are partially correct.');
  612: 	    $css_class=$possible_class{'not_charged_try'};
  613: 	} elsif ($awarded < 1) {
  614: 	    $message=&mt('Incorrect.');
  615: 	    $css_class=$possible_class{'charged_try'};
  616: 	}
  617: 	if ($env{'request.filename'} =~ 
  618: 	    m|/res/lib/templates/examupload.problem$|) {
  619: 	    $message = &mt("A score has been assigned.");
  620: 	    $added_computer_text=1;
  621: 	} else {
  622: 	    if ($target eq 'tex') {
  623: 		$message = '\textbf{'.$message.'}';
  624: 	    } else {
  625: 		$message = "<b>".$message."</b>";
  626: 		$message.= $computer;
  627: 	    }
  628: 	    $added_computer_text=1;
  629: 	    my ($symb) = &Apache::lonnet::whichuser();
  630: 	    if (($symb ne '') 
  631: 		&&
  632: 		($env{'course.'.$env{'request.course.id'}.
  633: 			    '.disable_receipt_display'} ne 'yes')) { 
  634: 		$message.=(($target eq 'web')?'<br />':' ').
  635: 		    &mt('Your receipt is').' '.&Apache::lonnet::receipt($Apache::inputtags::part).
  636: 		    (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');
  637: 	    }
  638: 	}
  639: 	$button=0;
  640: 	$previousmsg='';
  641:     } elsif ($solved =~ /^excused/) {
  642: 	if ($target eq 'tex') {
  643: 	    $message = ' \textbf{'.&mt('You are excused from the problem.').'} ';
  644: 	} else {
  645: 	    $message = "<b>".&mt('You are excused from the problem.')."</b>";
  646: 	}
  647: 	$css_class=$possible_class{'charged_try'};
  648: 	$button=0;
  649: 	$previousmsg='';
  650:     } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
  651: 	if ($solved =~ /^incorrect/ || $solved eq '') {
  652: 	    $message = &mt("Incorrect").".";
  653: 	    $css_class=$possible_class{'charged_try'};
  654: 	    $button=1;
  655: 	} else {
  656: 	    if ($target eq 'tex') {
  657: 		$message = '\textbf{'.&mt('You are correct.').'}';
  658: 	    } else {
  659: 		$message = "<b>".&mt('You are correct.')."</b>";
  660: 		$message.= $computer;
  661: 	    }
  662: 	    $added_computer_text=1;
  663: 	    unless ($env{'course.'.
  664: 			     $env{'request.course.id'}.
  665: 			     '.disable_receipt_display'} eq 'yes') { 
  666: 		$message.=(($target eq 'web')?'<br />':' ').
  667: 		    'Your receipt is '.&Apache::lonnet::receipt($Apache::inputtags::part).
  668: 		    (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');
  669: 	    }
  670: 	    $css_class=$possible_class{'correct'};
  671: 	    $button=0;
  672: 	    $previousmsg='';
  673: 	}
  674:     } elsif ($award eq 'NO_RESPONSE') {
  675: 	$message = '';
  676: 	$css_class=$possible_class{'no_feedback'};
  677: 	$button=1;
  678:     } elsif ($award eq 'EXTRA_ANSWER') {
  679: 	$message = &mt('Some extra items were submitted.');
  680: 	$css_class=$possible_class{'not_charged_try'};
  681: 	$button = 1;
  682:     } elsif ($award eq 'MISSING_ANSWER') {
  683: 	$message = &mt('Some items were not submitted.');
  684: 	$css_class=$possible_class{'not_charged_try'};
  685: 	$button = 1;
  686:     } elsif ($award eq 'ERROR') {
  687: 	$message = &mt('An error occured while grading your answer.');
  688: 	$css_class=$possible_class{'not_charged_try'};
  689: 	$button = 1;
  690:     } elsif ($award eq 'TOO_LONG') {
  691: 	$message = &mt("The submitted answer was too long.");
  692: 	$css_class=$possible_class{'not_charged_try'};
  693: 	$button=1;
  694:     } elsif ($award eq 'WANTED_NUMERIC') {
  695: 	$message = &mt("This question expects a numeric answer.");
  696: 	$css_class=$possible_class{'not_charged_try'};
  697: 	$button=1;
  698:     } elsif ($award eq 'MISORDERED_RANK') {
  699: 	$message = &mt('You have provided an invalid ranking');
  700: 	if ($target ne 'tex') {
  701: 	    $message.=', '.&mt('please refer to').' '.&Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems');
  702: 	}
  703: 	$css_class=$possible_class{'not_charged_try'};
  704: 	$button=1;
  705:     } elsif ($award eq 'INVALID_FILETYPE') {
  706: 	$message = &mt('Submission won\'t be graded. The type of file submitted is not allowed.');
  707: 	$css_class=$possible_class{'not_charged_try'};
  708: 	$button=1;
  709:     } elsif ($award eq 'SIG_FAIL') {
  710: 	my ($used,$min,$max)=split(':',$awardmsg);
  711: 	my $word = ($used < $min) ? 'more' : 'fewer';
  712: 	$message = &mt("Submission not graded.  Use $word digits.",$used);
  713: 	$css_class=$possible_class{'not_charged_try'};
  714: 	$button=1;
  715:     } elsif ($award eq 'UNIT_INVALID_INSTRUCTOR') {
  716: 	$message = &mt('Error in instructor specifed unit. This error has been reported to the instructor.', $awardmsg);
  717: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
  718: 	$css_class=$possible_class{'not_charged_try'};
  719: 	$button=1;
  720:     } elsif ($award eq 'UNIT_INVALID_STUDENT') {
  721: 	$message = &mt('Unable to interpret units. Computer reads units as "[_1]".',&markup_unit($awardmsg,$target));
  722: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
  723: 	$css_class=$possible_class{'not_charged_try'};
  724: 	$button=1;
  725:     } elsif ($award eq 'UNIT_FAIL' || $award eq 'UNIT_IRRECONCIBLE') {
  726: 	$message = &mt('Incompatible units. No conversion found between "[_1]" and the required units.',&markup_unit($awardmsg,$target));
  727: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
  728: 	$css_class=$possible_class{'not_charged_try'};
  729: 	$button=1;
  730:     } elsif ($award eq 'UNIT_NOTNEEDED') {
  731: 	$message = &mt('Only a number required. Computer reads units of "[_1]".',&markup_unit($awardmsg,$target));
  732: 	$css_class=$possible_class{'not_charged_try'};
  733: 	$button=1;
  734:     } elsif ($award eq 'NO_UNIT') {
  735: 	$message = &mt("Units required").'.';
  736: 	if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')};
  737: 	$css_class=$possible_class{'not_charged_try'};
  738: 	$button=1;
  739:     } elsif ($award eq 'COMMA_FAIL') {
  740: 	$message = &mt("Proper comma separation is required").'.';
  741: 	$css_class=$possible_class{'not_charged_try'};
  742: 	$button=1;
  743:     } elsif ($award eq 'BAD_FORMULA') {
  744: 	$message = &mt("Unable to understand formula");
  745: 	$css_class=$possible_class{'not_charged_try'};
  746: 	$button=1;
  747:     } elsif ($award eq 'INCORRECT') {
  748: 	$message = &mt("Incorrect").'.';
  749: 	$css_class=$possible_class{'charged_try'};
  750: 	$button=1;
  751:     } elsif ($award eq 'SUBMITTED') {
  752: 	$message = &mt("Your submission has been recorded.");
  753: 	$css_class=$possible_class{'no_grade'};
  754: 	$button=1;
  755:     } elsif ($award eq 'DRAFT') {
  756: 	$message = &mt("A draft copy has been saved.");
  757: 	$css_class=$possible_class{'not_charged_try'};
  758: 	$button=1;
  759:     } elsif ($award eq 'ASSIGNED_SCORE') {
  760: 	$message = &mt("A score has been assigned.");
  761: 	$css_class=$possible_class{'correct'};
  762: 	$button=0;
  763:     } elsif ($award eq '') {
  764: 	if ($handgrade && $Apache::inputtags::status[-1] eq 'SHOW_ANSWER') {
  765: 	    $message = &mt("Nothing submitted.");
  766: 	    $css_class=$possible_class{'charged_try'};
  767: 	} else {
  768: 	    $css_class=$possible_class{'not_charged_try'};
  769: 	}
  770: 	$button=1;
  771:     } else {
  772: 	$message = &mt("Unknown message").": $award";
  773: 	$button=1;
  774:     }
  775:     my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser();
  776:     foreach my $resid(@Apache::inputtags::response){
  777:         if ($Apache::lonhomework::history{"resource.$part.$resid.handback"}) {
  778: 	    $message.='<br />';
  779: 	    my @files = split(/\s*,\s*/,
  780: 			      $Apache::lonhomework::history{"resource.$part.$resid.handback"});
  781: 	    my $file_msg;
  782: 	    foreach my $file (@files) {
  783: 		$file_msg.= '<br /><a href="/uploaded/'."$domain/$user".'/'.$file.'">'.$file.'</a>';
  784: 	    }
  785: 	    $message .= &mt('Returned file(s): [_1]',$file_msg);
  786: 	}
  787:     }
  788: 
  789:     if (lc($Apache::lonhomework::problemstatus) eq 'no'  && 
  790: 	$Apache::inputtags::status[-1] ne 'SHOW_ANSWER') {
  791: 	$message = &mt("Answer Submitted: Your final submission will be graded after the due date.");
  792: 	$css_class=$possible_class{'no_grade'};
  793: 	$button=1;
  794:     }
  795:     if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && 
  796: 	!$added_computer_text && $target ne 'tex') {
  797: 	$message.= $computer;
  798: 	$added_computer_text=1;
  799:     }
  800:     return ($button,$css_class,$message,$previousmsg);
  801: }
  802: 
  803: sub markup_unit {
  804:     my ($unit,$target)=@_;
  805:     if ($target eq 'tex') {
  806: 	return '\texttt{'.&Apache::lonxml::latex_special_symbols($unit).'}'; 
  807:     } else {
  808: 	return "<tt>".$unit."</tt>";
  809:     }
  810: }
  811: 
  812: sub removealldata {
  813:     my ($id)=@_;
  814:     foreach my $key (keys(%Apache::lonhomework::results)) {
  815: 	if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
  816: 	    &Apache::lonxml::debug("Removing $key");
  817: 	    delete($Apache::lonhomework::results{$key});
  818: 	}
  819:     }
  820: }
  821: 
  822: sub hidealldata {
  823:     my ($id)=@_;
  824:     foreach my $key (keys(%Apache::lonhomework::results)) {
  825: 	if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
  826: 	    &Apache::lonxml::debug("Hidding $key");
  827: 	    my $newkey=$key;
  828: 	    $newkey=~s/^(resource\.\Q$id\E\.[^\.]+\.)(.*)$/${1}hidden${2}/;
  829: 	    $Apache::lonhomework::results{$newkey}=
  830: 		$Apache::lonhomework::results{$key};
  831: 	    delete($Apache::lonhomework::results{$key});
  832: 	}
  833:     }
  834: }
  835: 
  836: sub setgradedata {
  837:     my ($award,$msg,$id,$previously_used) = @_;
  838:     if ($Apache::lonhomework::scantronmode && 
  839: 	&Apache::lonnet::validCODE($env{'form.CODE'})) {
  840: 	$Apache::lonhomework::results{"resource.CODE"}=$env{'form.CODE'};
  841:     } elsif ($Apache::lonhomework::scantronmode && 
  842: 	     $env{'form.CODE'} eq '' &&
  843: 	     $Apache::lonhomework::history{"resource.CODE"} ne '') {
  844: 	$Apache::lonhomework::results{"resource.CODE"}='';
  845:     }
  846: 
  847:     if (!$Apache::lonhomework::scantronmode &&
  848: 	$Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
  849: 	$Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {
  850: 	$Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
  851: 	return '';
  852:     } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~
  853: 	      /^correct/ || $Apache::lonhomework::scantronmode ||
  854: 	      lc($Apache::lonhomework::problemstatus) eq 'no') {
  855:         # the student doesn't already have it correct,
  856: 	# or we are in a mode (scantron orno problem status) where a correct 
  857:         # can become incorrect
  858: 	# handle assignment of tries and solved status
  859: 	my $solvemsg;
  860: 	if ($Apache::lonhomework::scantronmode) {
  861: 	    $solvemsg='correct_by_scantron';
  862: 	} else {
  863: 	    $solvemsg='correct_by_student';
  864: 	}
  865: 	if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
  866: 	    $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
  867: 	}
  868: 	if ( $award eq 'ASSIGNED_SCORE') {
  869: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
  870: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  871: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
  872: 		$solvemsg;
  873: 	    my $numawards=scalar(@Apache::inputtags::response);
  874: 	    $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
  875: 	    foreach my $res (@Apache::inputtags::response) {
  876: 		$Apache::lonhomework::results{"resource.$id.awarded"}+=
  877: 		    $Apache::lonhomework::results{"resource.$id.$res.awarded"};
  878: 	    }
  879: 	    if ($numawards > 0) {
  880: 		$Apache::lonhomework::results{"resource.$id.awarded"}/=
  881: 		    $numawards;
  882: 	    }
  883: 	} elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
  884: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
  885: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  886: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
  887: 		$solvemsg;
  888: 	    $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
  889: 	} elsif ( $award eq 'INCORRECT' ) {
  890: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
  891: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  892: 	    if (lc($Apache::lonhomework::problemstatus) eq 'no' ||
  893: 		$Apache::lonhomework::scantronmode) {
  894: 		$Apache::lonhomework::results{"resource.$id.awarded"} = 0;
  895: 	    }
  896: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
  897: 		'incorrect_attempted';
  898: 	} elsif ( $award eq 'SUBMITTED' ) {
  899: 	    $Apache::lonhomework::results{"resource.$id.tries"} =
  900: 		$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  901: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
  902: 		'ungraded_attempted';
  903: 	} elsif ( $award eq 'DRAFT' ) {
  904: 	    $Apache::lonhomework::results{"resource.$id.solved"} = '';
  905: 	} elsif ( $award eq 'NO_RESPONSE' ) {
  906: 	    #no real response so delete any data that got stored
  907: 	    &removealldata($id);
  908: 	    return '';
  909: 	} else {
  910: 	    $Apache::lonhomework::results{"resource.$id.solved"} =
  911: 		'incorrect_attempted';
  912: 	    if (lc($Apache::lonhomework::problemstatus) eq 'no' ||
  913: 		$Apache::lonhomework::scantronmode) {
  914: 		$Apache::lonhomework::results{"resource.$id.tries"} =
  915: 		    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
  916: 		$Apache::lonhomework::results{"resource.$id.awarded"} = 0;
  917: 	    }
  918: 	}
  919: 	if (defined($msg)) {
  920: 	    $Apache::lonhomework::results{"resource.$id.awardmsg"} = $msg;
  921: 	}
  922: 	# did either of the overall awards chage? If so ignore the 
  923: 	# previous check
  924: 	if (($Apache::lonhomework::results{"resource.$id.awarded"} eq
  925: 	     $Apache::lonhomework::history{"resource.$id.awarded"}) &&
  926: 	    ($Apache::lonhomework::results{"resource.$id.solved"} eq
  927: 	     $Apache::lonhomework::history{"resource.$id.solved"})) {
  928: 	    # check if this was a previous submission if it was delete the
  929: 	    # unneeded data and update the previously_used attribute
  930: 	    if ( $previously_used eq 'PREVIOUSLY_USED') {
  931: 		if (lc($Apache::lonhomework::problemstatus) ne 'no') {
  932: 		    delete($Apache::lonhomework::results{"resource.$id.tries"});
  933: 		    $Apache::lonhomework::results{"resource.$id.previous"} = '1';
  934: 		}
  935: 	    } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
  936: 		#delete all data as they student didn't do anything, but save
  937: 		#the list of collaborators.
  938: 		&removealldata($id);
  939: 		#and since they didn't do anything we were never here
  940: 		return '';
  941: 	    } else {
  942: 		$Apache::lonhomework::results{"resource.$id.previous"} = '0';
  943: 	    }
  944: 	}
  945:     } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~
  946: 	      /^correct/ ) {
  947: 	#delete all data as they student already has it correct
  948: 	&removealldata($id);
  949: 	#and since they didn't do anything we were never here
  950: 	return '';
  951:     }
  952:     $Apache::lonhomework::results{"resource.$id.award"} = $award;
  953:     if ($award eq 'SUBMITTED') {
  954: 	&Apache::response::add_to_gradingqueue();
  955:     }
  956: }
  957: 
  958: sub find_which_previous {
  959:     my ($version) = @_;
  960:     my $part = $Apache::inputtags::part;
  961:     my (@previous_version);
  962:     foreach my $resp (@Apache::inputtags::response) {
  963: 	my $key = "$version:resource.$part.$resp.submission";
  964: 	my $submission = $Apache::lonhomework::history{$key};
  965: 	my %previous = &Apache::response::check_for_previous($submission,
  966: 							     $part,$resp,
  967: 							     $version);
  968: 	push(@previous_version,$previous{'version'});
  969:     }
  970:     return &previous_match(\@previous_version,
  971: 			   scalar(@Apache::inputtags::response));
  972: }
  973: 
  974: sub previous_match {
  975:     my ($previous_array,$count) = @_;
  976:     my $match = 0;
  977:     my @matches;
  978:     foreach my $versionar (@$previous_array) {
  979: 	foreach my $version (@$versionar) {
  980: 	    $matches[$version]++;
  981: 	}
  982:     }
  983:     my $which=0;
  984:     foreach my $elem (@matches) {
  985: 	if ($elem eq $count) {
  986: 	    $match=1;
  987: 	    last;
  988: 	}
  989: 	$which++;
  990:     }
  991:     return ($match,$which);
  992: }
  993: 
  994: sub grade {
  995:     my ($target) = @_;
  996:     my $id = $Apache::inputtags::part;
  997:     my $response='';
  998:     if ( defined $env{'form.submitted'}) {
  999: 	my (@awards,@msgs);
 1000: 	foreach $response (@Apache::inputtags::response) {
 1001: 	    &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
 1002: 	    my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
 1003: 	    &Apache::lonxml::debug("keeping $value from $response for $id");
 1004: 	    push (@awards,$value);
 1005: 	    $value=$Apache::lonhomework::results{"resource.$id.$response.awardmsg"};
 1006: 	    &Apache::lonxml::debug("got message $value from $response for $id");
 1007: 	    push (@msgs,$value);
 1008: 	}
 1009: 	my ($finalaward,$msg) = &finalizeawards(\@awards,\@msgs);
 1010: 	my $previously_used;
 1011: 	if ( $#Apache::inputtags::previous eq $#awards ) {
 1012: 	    my ($match) =
 1013: 		&previous_match(\@Apache::inputtags::previous_version,
 1014: 				scalar(@Apache::inputtags::response));
 1015: 	    
 1016: 	    if ($match) {
 1017: 		$previously_used = 'PREVIOUSLY_LAST';
 1018: 		foreach my $value (@Apache::inputtags::previous) {
 1019: 		    if ($value eq 'PREVIOUSLY_USED' ) {
 1020: 			$previously_used = $value;
 1021: 			last;
 1022: 		    }
 1023: 		}
 1024: 	    }
 1025: 	}
 1026: 	&Apache::lonxml::debug("final award $finalaward, $previously_used, message $msg");
 1027: 	&setgradedata($finalaward,$msg,$id,$previously_used);
 1028:     }
 1029:     return '';
 1030: }
 1031: 
 1032: sub get_grade_messages {
 1033:     my ($id,$prefix,$target,$status) = @_;
 1034: 
 1035:     my ($message,$latemessage,$trystr,$previousmsg);
 1036:     my $showbutton = 1;
 1037: 
 1038:     my $award = $Apache::lonhomework::history{"$prefix.award"};
 1039:     my $awarded = $Apache::lonhomework::history{"$prefix.awarded"};
 1040:     my $solved = $Apache::lonhomework::history{"$prefix.solved"};
 1041:     my $previous = $Apache::lonhomework::history{"$prefix.previous"};
 1042:     my $awardmsg = $Apache::lonhomework::history{"$prefix.awardmsg"};
 1043:     &Apache::lonxml::debug("Found Award |$award|$solved|$awardmsg");
 1044:     if ( $award ne '' || $solved ne '' || $status eq 'SHOW_ANSWER') {
 1045: 	&Apache::lonxml::debug('Getting message');
 1046: 	($showbutton,my $css_class,$message,$previousmsg) =
 1047: 	    &decideoutput($award,$awarded,$awardmsg,$solved,$previous,
 1048: 			  $target);
 1049: 	if ($target eq 'tex') {
 1050: 	    $message='\vskip 2 mm '.$message.' ';
 1051: 	} else {
 1052: 	    $message="<td class=\"$css_class\">$message</td>";
 1053: 	    if ($previousmsg) {
 1054: 		$previousmsg="<td class=\"LC_answer_previous\">$previousmsg</td>";
 1055: 	    }
 1056: 	}
 1057:     }
 1058:     my $tries = $Apache::lonhomework::history{"$prefix.tries"};
 1059:     my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
 1060:     &Apache::lonxml::debug("got maxtries of :$maxtries:");
 1061:     #if tries are set to negative turn off the Tries/Button and messages
 1062:     if (defined($maxtries) && $maxtries < 0) { return ''; }
 1063:     if ( $tries eq '' ) { $tries = '0'; }
 1064:     if ( $maxtries eq '' ) { $maxtries = '2'; } 
 1065:     if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
 1066:     my $tries_text=&mt('Tries');
 1067:     if ( $Apache::lonhomework::type eq 'survey' ||
 1068: 	 $Apache::lonhomework::parsing_a_task) {
 1069: 	$tries_text=&mt('Submissions');
 1070:     }
 1071: 
 1072:     if ($showbutton) {
 1073: 	if ($target eq 'tex') {
 1074: 	    if ($env{'request.state'} ne "construct"
 1075: 		&& $Apache::lonhomework::type ne 'exam'
 1076: 		&& $env{'form.suppress_tries'} ne 'yes') {
 1077: 		$trystr = ' {\vskip 1 mm \small \textit{'.$tries_text.'} '.
 1078: 		    $tries.'/'.$maxtries.'} \vskip 2 mm ';
 1079: 	    } else {
 1080: 		$trystr = '\vskip 0 mm ';
 1081: 	    }
 1082: 	} else {
 1083: 	    $trystr = "<td><nobr>".$tries_text." $tries";
 1084: 	    if ($Apache::lonhomework::parsing_a_task) {
 1085: 	    } elsif($env{'request.state'} ne 'construct') {
 1086: 		$trystr.="/$maxtries";
 1087: 	    } else {
 1088: 		if (defined($Apache::inputtags::params{'maxtries'})) {
 1089: 		    $trystr.="/".$Apache::inputtags::params{'maxtries'};
 1090: 		}
 1091: 	    }
 1092: 	    $trystr.="</nobr></td>";
 1093: 	}
 1094:     }
 1095: 
 1096:     if ($Apache::lonhomework::history{"$prefix.afterduedate"}) {
 1097: 	#last submissions was after due date
 1098: 	$latemessage=&mt(' The last submission was after the Due Date ');;
 1099: 	if ($target eq 'web') {
 1100: 	    $latemessage='<td class="LC_answer_late">'.$latemessage.'</td>';
 1101: 	}
 1102:     }
 1103:     return ($previousmsg,$latemessage,$message,$trystr,$showbutton);
 1104: }
 1105: 
 1106: sub gradestatus {
 1107:     my ($id,$target,$no_previous) = @_;
 1108:     my $showbutton = 1;
 1109:     my $message = '';
 1110:     my $latemessage = '';
 1111:     my $trystr='';
 1112:     my $button='';
 1113:     my $previousmsg='';
 1114: 
 1115:     my $status = $Apache::inputtags::status['-1'];
 1116:     &Apache::lonxml::debug("gradestatus has :$status:");
 1117:     if ( $status ne 'CLOSED' 
 1118: 	 && $status ne 'UNAVAILABLE' 
 1119: 	 && $status ne 'INVALID_ACCESS' 
 1120: 	 && $status ne 'NEEDS_CHECKIN' 
 1121: 	 && $status ne 'NOT_IN_A_SLOT') {  
 1122: 
 1123: 	($previousmsg,$latemessage,$message,$trystr) =
 1124: 	    &get_grade_messages($id,"resource.$id",$target,$status,
 1125: 				$showbutton);
 1126: 	if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
 1127: 	    $showbutton = 0;
 1128: 	}
 1129: 	if ( $status eq 'SHOW_ANSWER') {
 1130: 	    undef($previousmsg);
 1131: 	}
 1132: 	if ( $showbutton ) { 
 1133: 	    if ($target ne 'tex') {
 1134: 		$button = 
 1135: 		    '<input 
 1136:                           onmouseup="javascript:setSubmittedPart(\''.$id.'\')"
 1137:                            onsubmit="javascript:setSubmittedPart(\''.$id.'\')"
 1138:                         type="submit" name="submit_'.$id.'"
 1139:                          value="'.&mt('Submit Answer').'" />';
 1140: 	    }
 1141: 	}
 1142: 
 1143:     }
 1144:     my $output= $previousmsg.$latemessage.$message.$trystr;
 1145:     if ($output =~ /^\s*$/) {
 1146: 	return $button;
 1147:     } else {
 1148: 	if ($target eq 'tex') {
 1149: 	    return $button.' \vskip 0 mm '.$output.' ';
 1150: 	} else {
 1151: 	    $output =
 1152: 		'<table><tr><td>'.$button.'</td>'.$output;
 1153: 	    if (!$no_previous) {
 1154: 		$output.='<td>'.&previous_tries($id,$target).'</td>';
 1155: 	    }
 1156: 	    $output.= '</tr></table>';
 1157: 	    return $output;
 1158: 	}
 1159:     }
 1160: }
 1161: 
 1162: sub previous_tries {
 1163:     my ($id,$target) = @_;
 1164:     my $output;
 1165:     my $status = $Apache::inputtags::status['-1'];
 1166: 
 1167:     my $count;
 1168:     my %count_lookup;
 1169: 
 1170:     foreach my $i (1..$Apache::lonhomework::history{'version'}) {
 1171: 	my $prefix = $i.":resource.$id";
 1172: 
 1173: 	next if (!exists($Apache::lonhomework::history{"$prefix.award"}));
 1174: 	$count++;
 1175: 	$count_lookup{$i} = $count;
 1176: 	
 1177: 	my ($previousmsg,$latemessage,$message,$trystr);
 1178: 
 1179: 	($previousmsg,$latemessage,$message,$trystr) =
 1180: 	    &get_grade_messages($id,"$prefix",$target,$status);
 1181: 
 1182: 	if ($previousmsg ne '') {
 1183: 	    my ($match,$which) = &find_which_previous($i);
 1184: 	    $message=$previousmsg;
 1185: 	    my $previous = $count_lookup{$which};
 1186: 	    $message =~ s{(</td>)}{ as submission \# $previous $1};
 1187: 	} elsif ($Apache::lonhomework::history{"$prefix.tries"}) {
 1188: 	    if (!(lc($Apache::lonhomework::problemstatus) eq 'no'
 1189: 		  && $Apache::inputtags::status[-1] ne 'SHOW_ANSWER')
 1190: 		&& $Apache::lonhomework::history{"$prefix.solved"} =~/^correct/
 1191: 		) {
 1192: 		
 1193: 		$message =~ s{(<td.*?>)(.*?)(</td>)}
 1194: 		             {$1 <strong>Correct</strong>. $3}s;
 1195: 	    }
 1196: 	    my $trystr = "(Try ".
 1197: 		$Apache::lonhomework::history{"$prefix.tries"}.')';
 1198: 	    $message =~ s{(</td>)}{ $trystr $1};
 1199: 	}
 1200: 	my ($class) = ($message =~ m{<td.*class="([^"]*)"}); #"
 1201: 	$message =~ s{(<td.*?>)}{<td>};
 1202: 	
 1203: 
 1204: 	$output.='<tr class="'.$class.'">';
 1205: 	$output.='<td align="center">'.$count.'</td>';
 1206: 	$output.=$message;
 1207: 
 1208: 	foreach my $resid (@Apache::inputtags::response) {
 1209: 	    my $prefix = $prefix.".$resid";
 1210: 	    if (exists($Apache::lonhomework::history{"$prefix.submission"})) {
 1211: 		my $submission =
 1212: 		    $Apache::inputtags::submission_display{"$prefix.submission"};
 1213: 		if (!defined($submission)) {
 1214: 		    $submission = 
 1215: 			$Apache::lonhomework::history{"$prefix.submission"};
 1216: 		}
 1217: 		$output.='<td>'.$submission.'</td>';
 1218: 	    } else {
 1219: 		$output.='<td></td>';
 1220: 	    }
 1221: 	}
 1222: 	$output.=&Apache::loncommon::end_data_table_row()."\n";
 1223:     }
 1224:     return if ($output eq '');
 1225:     my $headers = 
 1226: 	'<tr>'.'<th>'.&mt('Submission #').'</th><th>'.&mt('Try').
 1227: 	'</th><th colspan="'.scalar(@Apache::inputtags::response).'">'.
 1228: 	&mt('Submitted Answer').'</th>';
 1229:     $output ='<table class="LC_prior_tries">'.$headers.$output.'</table>';
 1230:     #return $output;
 1231:     $output = &Apache::loncommon::js_ready($output); 
 1232:     $output.='<br /><form action=""><center><input type="button" name="close" value="'.&mt('Close Window').'" onClick="window.close()" /></center></form>';
 1233: 
 1234:     my $windowopen=&Apache::lonhtmlcommon::javascript_docopen();
 1235:     my $start_page =
 1236: 	&Apache::loncommon::start_page('Previous Tries', undef,
 1237: 				       {'only_body'      => 1,
 1238: 					'bgcolor'        => '#FFFFFF',
 1239: 					'js_ready'       => 1,
 1240: 				        'inherit_jsmath' => 1, });
 1241:     my $end_page =
 1242: 	&Apache::loncommon::end_page({'js_ready' => 1,});
 1243:     
 1244:     my $result ="<script type=\"text/javascript\">
 1245: // <![CDATA[
 1246:     function LONCAPA_previous_tries_$Apache::lonxml::curdepth() {newWindow=open('','new_W','width=500,height=500,scrollbars=1,resizable=yes');newWindow.$windowopen;newWindow.document.writeln('$start_page $output $end_page');newWindow.document.close();newWindow.focus()}
 1247: // ]]>
 1248: </script><a href=\"javascript:LONCAPA_previous_tries_$Apache::lonxml::curdepth();void(0);\">".&mt("Previous Tries")."</a><br />";
 1249:     #use Data::Dumper;
 1250:     #&Apache::lonnet::logthis(&Dumper(\%Apache::inputtags::submission_display));
 1251:     return $result;
 1252: }
 1253: 
 1254: 1;
 1255: __END__
 1256:  

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