Annotation of loncom/homework/inputtags.pm, revision 1.101

1.43      albertel    1: # The LearningOnline Network with CAPA
                      2: # input  definitons
1.47      albertel    3: #
1.101   ! albertel    4: # $Id: inputtags.pm,v 1.100 2003/05/08 15:33:15 albertel Exp $
1.47      albertel    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: #
1.43      albertel   28: # 2/19 Guy 
1.1       albertel   29: 
                     30: package Apache::inputtags;
1.55      albertel   31: use HTML::Entities();
1.1       albertel   32: use strict;
1.82      www        33: use Apache::loncommon;
1.1       albertel   34: 
1.50      harris41   35: BEGIN {
1.98      albertel   36:   &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));
1.1       albertel   37: }
                     38: 
1.43      albertel   39: 
1.1       albertel   40: sub initialize_inputtags {
1.43      albertel   41:   # list of current input ids
                     42:   @Apache::inputtags::input=();
                     43:   # list of all input ids seen in this problem
                     44:   @Apache::inputtags::inputlist=();
                     45:   # list of all current response ids
                     46:   @Apache::inputtags::response=();
                     47:   # list of all response ids seen in this problem
                     48:   @Apache::inputtags::responselist=();
                     49:   # list of whether or not a specific response was previously used
                     50:   @Apache::inputtags::previous=();
1.75      albertel   51:   # submission it was used in
                     52:   @Apache::inputtags::previous_version=();
1.43      albertel   53:   # id of current part, 0 means that no part is current (inside <problem> only
                     54:   $Apache::inputtags::part='';
1.46      albertel   55:   # list of problem date statuses, the first element is for <problem>
                     56:   # if there is a second element it is for the current <part>
1.43      albertel   57:   @Apache::inputtags::status=();
1.46      albertel   58:   # hash of defined params for the current response
1.43      albertel   59:   %Apache::inputtags::params=();
1.46      albertel   60:   # list of all ids, for <import>, these get join()ed and prepended
                     61:   @Apache::inputtags::import=();
1.1       albertel   62: }
                     63: 
1.14      albertel   64: sub start_input {
1.43      albertel   65:   my ($parstack,$safeeval)=@_;
                     66:   my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
                     67:   if ($id eq '') { $id = $Apache::lonxml::curdepth; }
                     68:   push (@Apache::inputtags::input,$id);
                     69:   push (@Apache::inputtags::inputlist,$id);
                     70:   return $id;
1.14      albertel   71: }
                     72: 
                     73: sub end_input {
1.43      albertel   74:   pop @Apache::inputtags::input;
                     75:   return '';
1.14      albertel   76: }
                     77: 
1.48      albertel   78: sub start_textfield {
1.43      albertel   79:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                     80:   my $result = "";
                     81:   my $id = &start_input($parstack,$safeeval);
1.55      albertel   82:   my $resid=$Apache::inputtags::response[-1];
1.43      albertel   83:   if ($target eq 'web') {
1.57      albertel   84:     $Apache::lonxml::evaluate--;
1.100     albertel   85:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
1.61      albertel   86: 	my $partid=$Apache::inputtags::part;
                     87: 	my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"});
                     88: 	my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
                     89: 	if ( $cols eq '') { $cols = 80; }
                     90: 	my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
                     91: 	if ( $rows eq '') { $rows = 10; }
1.89      albertel   92: 	$result= '<textarea name="HWVAL_'.$resid.'" '.
1.61      albertel   93: 	    "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
                     94: 	if ($oldresponse ne '') {
                     95: 	    #get rid of any startup text if the user has already responded
1.84      albertel   96: 	    &Apache::lonxml::get_all_text("/textfield",$parser);
1.61      albertel   97: 	}
1.45      albertel   98:     } else {
1.61      albertel   99: 	#right or wrong don't show it
                    100: 	#$result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';
                    101: 	$result='';
                    102: 	#get rid of any startup text
1.84      albertel  103: 	&Apache::lonxml::get_all_text("/textfield",$parser);
1.51      albertel  104:     }
1.60      albertel  105:   } elsif ($target eq 'grade') {
1.84      albertel  106:     my $seedtext=&Apache::lonxml::get_all_text("/textfield",$parser);
1.89      albertel  107:     if ($seedtext eq $ENV{'form.HWVAL_'.$resid}) {
1.51      albertel  108:       # if the seed text is still there it wasn't a real submission
1.89      albertel  109:       $ENV{'form.HWVAL_'.$resid}='';
1.30      albertel  110:     }
1.60      albertel  111:   } elsif ($target eq 'edit') {
                    112:     $result.=&Apache::edit::tag_start($target,$token);
                    113:     $result.=&Apache::edit::text_arg('Rows:','rows',$token,4);
                    114:     $result.=&Apache::edit::text_arg('Columns:','cols',$token,4);
1.84      albertel  115:     my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser);
1.62      albertel  116:     $result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);
1.60      albertel  117:   } elsif ($target eq 'modified') {
                    118:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,
                    119: 						 $safeeval,'rows','cols');
                    120:     if ($constructtag) {
                    121:       $result = &Apache::edit::rebuild_tag($token);
                    122:     } else {
                    123:       $result=$token->[4];
                    124:     }
                    125:     $result.=&Apache::edit::modifiedfield();
1.78      sakharuk  126:   } elsif ($target eq 'tex') {
1.94      sakharuk  127:       my $number_of_lines = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
                    128:       my $width_of_box = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
1.78      sakharuk  129:       if ($$tagstack[-2] eq 'essayresponse' and $Apache::lonhomework::type eq 'exam') {
                    130: 	  $result = '\fbox{\fbox{\parbox{\textwidth-5mm}{';
1.94      sakharuk  131: 	  for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
                    132: 	  $result.='\strut \\\\\strut \\\\\strut \\\\\strut \\\\}}}';
                    133:       } else {
                    134: 	  my $TeXwidth=$width_of_box/80;
                    135: 	  $result = '\vskip 1 mm \fbox{\fbox{\parbox{'.$TeXwidth.'\textwidth-5mm}{';
                    136: 	  for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
                    137: 	  $result.='}}}\vskip 2 mm ';
1.78      sakharuk  138:       }
1.43      albertel  139:   }
                    140:   return $result;
1.6       albertel  141: }
                    142: 
1.48      albertel  143: sub end_textfield {
1.43      albertel  144:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.60      albertel  145:   my $result;
1.43      albertel  146:   if ($target eq 'web') {
1.57      albertel  147:     $Apache::lonxml::evaluate++;
1.45      albertel  148:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
                    149:       return "</textarea>";
                    150:     }
1.60      albertel  151:   } elsif ($target eq 'edit') {
                    152:     $result=&Apache::edit::end_table();
1.45      albertel  153:   }
1.43      albertel  154:   &end_input;
1.60      albertel  155:   return $result;
1.6       albertel  156: }
                    157: 
1.1       albertel  158: sub start_textline {
1.43      albertel  159:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                    160:   my $result = "";
                    161:   if ($target eq 'web') {
1.57      albertel  162:     $Apache::lonxml::evaluate--;
1.99      albertel  163:     my $partid=$Apache::inputtags::part;
                    164:     my $id=$Apache::inputtags::response[-1];
1.100     albertel  165:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
1.61      albertel  166:       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
1.72      albertel  167:       my $maxlength;
                    168:       if ($size eq '') { $size=20; } else {
                    169: 	if ($size < 20) { $maxlength=$size; }
                    170:       }
1.61      albertel  171:       my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});
1.73      sakharuk  172:       if ($Apache::lonhomework::type ne 'exam') {
1.89      albertel  173:         $result= '<input type="text" name="HWVAL_'.$id.'" value="'.
1.73      sakharuk  174: 	    $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';
                    175:       }
1.45      albertel  176:     } else {
1.61      albertel  177:       #right or wrong don't show what was last typed in.
                    178:       #$result='<i>'.$oldresponse.'</i>';
                    179:       $result='';
1.45      albertel  180:     }
1.44      albertel  181:   } elsif ($target eq 'edit') {
1.49      matthew   182:     $result=&Apache::edit::tag_start($target,$token);
1.43      albertel  183:     $result.=&Apache::edit::text_arg('Size:','size',$token,'5')."</td></tr>";
                    184:     $result.=&Apache::edit::end_table;
1.44      albertel  185:   } elsif ($target eq 'modified') {
1.43      albertel  186:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size');
                    187:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.78      sakharuk  188:   } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') {
1.76      sakharuk  189:       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
                    190:       if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';}
1.96      sakharuk  191:       $result='\framebox['.$size.'][s]{\tiny\strut}';
1.43      albertel  192:   }
                    193:   return $result;
1.1       albertel  194: }
                    195: 
                    196: sub end_textline {
1.43      albertel  197:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.57      albertel  198:   if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
                    199:   elsif ($target eq 'edit') { return ('','no'); }
1.43      albertel  200:   return "";
1.9       albertel  201: }
                    202: 
1.98      albertel  203: sub start_hiddenline {
                    204:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                    205:     my $result = "";
                    206:     if ($target eq 'web') {
                    207: 	$Apache::lonxml::evaluate--;
                    208: 	if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
                    209: 	    my $partid=$Apache::inputtags::part;
                    210: 	    my $id=$Apache::inputtags::response[-1];
                    211: 	    my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});
                    212: 	    if ($Apache::lonhomework::type ne 'exam') {
                    213: 		$result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.
                    214: 		    $oldresponse.'" />';
                    215: 	    }
                    216: 	}
                    217:     } elsif ($target eq 'edit') {
                    218: 	$result=&Apache::edit::tag_start($target,$token);
                    219: 	$result.=&Apache::edit::end_table;
                    220:     }
                    221:     return $result;
                    222: }
                    223: 
                    224: sub end_hiddenline {
                    225:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                    226:   if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
                    227:   elsif ($target eq 'edit') { return ('','no'); }
                    228:   return "";
                    229: }
                    230: 
1.9       albertel  231: sub finalizeawards {
1.43      albertel  232:   my $result='';
                    233:   my $award;
                    234:   if ($#_ == '-1') { $result = "NO_RESPONSE"; }
                    235:   if ($result eq '' ) {
1.54      albertel  236:     my $blankcount;
                    237:     foreach $award (@_) {
                    238:       if ($award eq '') {
                    239: 	$result='MISSING_ANSWER';
                    240: 	$blankcount++;
                    241:       }
                    242:     }
                    243:     if ($blankcount == ($#_ + 1)) { $result = 'NO_RESPONSE'; }
1.56      albertel  244:   }
                    245:   if ($result eq '' ) {
                    246:     foreach $award (@_) { if ($award eq 'MISSING_ANSWER') {$result='MISSING_ANSWER'; last;}}
1.43      albertel  247:   }
                    248:   if ($result eq '' ) {
                    249:     foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
                    250:   }
                    251:   if ($result eq '' ) {
                    252:     foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} }
                    253:   }
                    254: 
                    255:   if ($result eq '' ) {
                    256:     foreach $award (@_) { 
                    257:       if ($award eq 'UNIT_FAIL' ||
                    258: 	  $award eq 'NO_UNIT' ||
                    259: 	  $award eq 'UNIT_NOTNEEDED') {
                    260: 	$result=$award; last;
                    261:       }
                    262:     }
                    263:   }
                    264:   if ($result eq '' ) {
                    265:     foreach $award (@_) { 
                    266:       if ($award eq 'WANTED_NUMERIC' || 
                    267: 	  $award eq 'BAD_FORMULA') {$result=$award; last;}
                    268:     }
                    269:   }
                    270:   if ($result eq '' ) {
                    271:     foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} }
                    272:   }
                    273:   if ($result eq '' ) {
                    274:     foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} }
                    275:   }
                    276:   if ($result eq '' ) {
1.79      albertel  277:       foreach $award (@_) { if ($award eq 'MISORDERED_RANK') {$result=$award; last;} }
                    278:   }
                    279:   if ($result eq '' ) {
1.80      www       280:       foreach $award (@_) { if ($award eq 'INVALID_FILETYPE') {$result=$award; last;} }
                    281:   }
                    282:   if ($result eq '' ) {
1.59      ng        283:     foreach $award (@_) { if ($award eq 'DRAFT') {$result=$award; last;} }
                    284:   }
                    285:   if ($result eq '' ) {
1.43      albertel  286:     foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} }
                    287:   }
                    288:   if ($result eq '' ) {
1.92      albertel  289:     foreach $award (@_) { if ($award eq 'ASSIGNED_SCORE') {$result=$award; last;} }
                    290:   }
                    291:   if ($result eq '' ) {
1.43      albertel  292:     foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} }
                    293:   }
                    294:   if ($result eq '' ) { $result='EXACT_ANS'; }
                    295:   return $result
1.9       albertel  296: }
                    297: 
1.10      albertel  298: sub decideoutput {
1.68      sakharuk  299:   my ($award,$solved,$previous,$target)=@_;
1.43      albertel  300:   my $message='';
                    301:   my $button=0;
                    302:   my $previousmsg;
                    303: 
                    304:   if ($previous) { $previousmsg='You have entered that answer before'; }
                    305: 
                    306:   if      ($solved =~ /^correct/) {
1.92      albertel  307:       if ($award eq 'ASSIGNED_SCORE') {
                    308: 	  $message = "A score has been assigned.";
1.91      sakharuk  309:       } else {
1.92      albertel  310: 	  if ($target eq 'tex') {
                    311: 	      $message = '\textbf{You are correct}.';
                    312: 	  } else {
                    313: 	      $message = "<b>You are correct.</b>";
                    314: 	  }
                    315: 	  $message=' Your receipt is '.&Apache::lonnet::receipt;
1.91      sakharuk  316:       }
                    317:       $button=0;
                    318:       $previousmsg='';
1.43      albertel  319:   } elsif ($solved =~ /^excused/) {
1.91      sakharuk  320:       $message = "<b>You are excused from the problem.</b>";
1.43      albertel  321:       $button=0;
                    322:       $previousmsg='';
1.91      sakharuk  323:   } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
                    324:       if ($solved =~ /^incorrect/ || $solved eq '') {
                    325: 	  $message = "Incorrect";
                    326: 	  $button=1;
                    327:       } else {
                    328: 	  $message = "<b>You are correct.</b> Your receipt is ".
                    329: 	   &Apache::lonnet::receipt;
                    330: 	  $button=0;
                    331: 	  $previousmsg='';
                    332:       }
1.43      albertel  333:   } elsif ($award eq 'NO_RESPONSE') {
1.91      sakharuk  334:       $message = '';
                    335:       $button=1;
1.43      albertel  336:   } elsif ($award eq 'MISSING_ANSWER') {
1.91      sakharuk  337:       $message = 'Some parts were not submitted';
                    338:       $button = 1;
1.43      albertel  339:   } elsif ($award eq 'WANTED_NUMERIC') {
1.91      sakharuk  340:       $message = "This question expects a numeric answer";
                    341:       $button=1;
1.79      albertel  342:   } elsif ($award eq 'MISORDERED_RANK') {
1.91      sakharuk  343:       $message = 'You have provided an invalid ranking, please refer to '.
                    344:        &Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems').'.';
                    345:       $button=1;
1.80      www       346:   } elsif ($award eq 'INVALID_FILETYPE') {
1.91      sakharuk  347:       $message = 'The filetype extension of the file you uploaded is not allowed.';
                    348:       $button=1;
1.43      albertel  349:   } elsif ($award eq 'SIG_FAIL') {
1.91      sakharuk  350:       $message = "Please adjust significant figures.";# you provided %s significant figures";
                    351:       $button=1;
1.43      albertel  352:   } elsif ($award eq 'UNIT_FAIL') {
1.91      sakharuk  353:       $message = "Units incorrect. ".
1.82      www       354:        &Apache::loncommon::help_open_topic('Physical_Units'); #Computer reads units as %s";
1.91      sakharuk  355:       $button=1;
1.43      albertel  356:   } elsif ($award eq 'UNIT_NOTNEEDED') {
1.91      sakharuk  357:       $message = "Only a number required.";# Computer reads units of %s";
                    358:       $button=1;
1.43      albertel  359:   } elsif ($award eq 'NO_UNIT') {
1.91      sakharuk  360:       $message = "Units required".
1.82      www       361:        &Apache::loncommon::help_open_topic('Physical_Units');
1.91      sakharuk  362:       $button=1;
1.43      albertel  363:   } elsif ($award eq 'BAD_FORMULA') {
1.91      sakharuk  364:       $message = "Unable to understand formula";
                    365:       $button=1;
1.43      albertel  366:   } elsif ($award eq 'INCORRECT') {
1.91      sakharuk  367:       $message = "Incorrect";
                    368:       $button=1;
1.43      albertel  369:   } elsif ($award eq 'SUBMITTED') {
1.91      sakharuk  370:       $message = "Your submission has been recorded.";
                    371:       $button=1;
1.59      ng        372:   } elsif ($award eq 'DRAFT') {
1.91      sakharuk  373:       $message = "A draft copy has been saved.";
                    374:       $button=1;
1.92      albertel  375:   } elsif ($award eq 'ASSIGNED_SCORE') {
                    376:       $message = "A score has been assigned.";
                    377:       $button=0;
1.43      albertel  378:   } else {
1.91      sakharuk  379:       $message = "Unknown message: $award";
                    380:       $button=1;
1.98      albertel  381:   }
                    382:   if (lc($Apache::lonhomework::problemstatus) eq 'no') {
1.91      sakharuk  383:       $message = "Answer Submitted";
                    384:       $button=1;
1.43      albertel  385:   }
                    386:   return ($button,$message,$previousmsg);
1.12      albertel  387: }
                    388: 
1.88      albertel  389: sub removealldata {
1.87      albertel  390:     my ($id)=@_;
                    391:     foreach my $key (keys(%Apache::lonhomework::results)) {
                    392: 	if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
                    393: 	    &Apache::lonxml::debug("Removing $key");
                    394: 	    delete($Apache::lonhomework::results{$key});
                    395: 	}
                    396:     }
                    397: }
                    398: 
1.12      albertel  399: sub setgradedata {
1.43      albertel  400:   my ($award,$id,$previously_used) = @_;
                    401:   # if the student already has it correct, don't modify the status
1.71      albertel  402:   if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
                    403:       $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {
1.53      albertel  404:     $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
                    405:     return '';
                    406:   } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~
1.101   ! albertel  407:        /^correct/ || $Apache::lonhomework::scantronmode ||
        !           408: 	    lc($Apache::lonhomework::problemstatus) eq 'no') {
1.43      albertel  409:     #handle assignment of tries and solved status
1.93      albertel  410:     my $solvemsg;
                    411:     if ($Apache::lonhomework::scantronmode) {
                    412: 	$solvemsg='correct_by_scantron';
                    413:     } else {
                    414: 	$solvemsg='correct_by_student';
                    415:     }
1.53      albertel  416:     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
                    417:       $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
                    418:     }
1.92      albertel  419:     if ( $award eq 'ASSIGNED_SCORE') {
                    420: 	$Apache::lonhomework::results{"resource.$id.tries"} =
                    421: 	    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
                    422: 	$Apache::lonhomework::results{"resource.$id.solved"} =
1.93      albertel  423: 	    $solvemsg;
                    424: 	my $numawards=scalar(@Apache::inputtags::responselist);
                    425: 	&Apache::lonxml::debug("Whaaa!");
1.92      albertel  426: 	$Apache::lonhomework::results{"resource.$id.awarded"} = 0;
1.93      albertel  427: 	foreach my $res (@Apache::inputtags::responselist) {
1.92      albertel  428: 	    $Apache::lonhomework::results{"resource.$id.awarded"}+=
                    429: 	       $Apache::lonhomework::results{"resource.$id.$res.awarded"};
                    430: 	}
1.93      albertel  431: 	if ($numawards > 0) {
                    432: 	    $Apache::lonhomework::results{"resource.$id.awarded"}/=
                    433: 		$numawards;
                    434: 	}
1.92      albertel  435:     } elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
1.43      albertel  436:       $Apache::lonhomework::results{"resource.$id.tries"} =
                    437: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
                    438:       $Apache::lonhomework::results{"resource.$id.solved"} =
1.93      albertel  439: 	$solvemsg;
1.43      albertel  440:       $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
                    441:     } elsif ( $award eq 'INCORRECT' ) {
                    442:       $Apache::lonhomework::results{"resource.$id.tries"} =
                    443: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
                    444:       $Apache::lonhomework::results{"resource.$id.solved"} =
1.59      ng        445: 	'incorrect_attempted'
1.43      albertel  446:     } elsif ( $award eq 'SUBMITTED' ) {
                    447:       $Apache::lonhomework::results{"resource.$id.tries"} =
                    448: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
                    449:       $Apache::lonhomework::results{"resource.$id.solved"} =
                    450: 	'ungraded_attempted';
1.59      ng        451:     } elsif ( $award eq 'DRAFT' ) {
                    452:       $Apache::lonhomework::results{"resource.$id.solved"} = '';
1.43      albertel  453:     } elsif ( $award eq 'NO_RESPONSE' ) {
1.87      albertel  454: 	#no real response so delete any data that got stored
                    455: 	&removealldata($id);
                    456: 	return '';
1.43      albertel  457:     } else {
                    458:       $Apache::lonhomework::results{"resource.$id.solved"} =
                    459: 	'incorrect_attempted';
1.101   ! albertel  460:       if (lc($Apache::lonhomework::problemstatus) eq 'no') {
        !           461: 	  $Apache::lonhomework::results{"resource.$id.tries"} =
        !           462: 	      $Apache::lonhomework::history{"resource.$id.tries"} + 1;
        !           463:       }
1.43      albertel  464:     }
                    465: 
                    466:     # check if this was a previous submission if it was delete the
                    467:     # unneeded data and update the previously_used attribute
                    468:     if ( $previously_used eq 'PREVIOUSLY_USED') {
1.101   ! albertel  469: 	if (lc($Apache::lonhomework::problemstatus) ne 'no') {
        !           470: 	    delete($Apache::lonhomework::results{"resource.$id.tries"});
        !           471: 	    $Apache::lonhomework::results{"resource.$id.previous"} = '1';
        !           472: 	}
1.43      albertel  473:     } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
1.58      ng        474:       #delete all data as they student didn't do anything, but save
                    475:       #the list of collaborators.
1.87      albertel  476:       &removealldata($id);
1.43      albertel  477:       #and since they didn't do anything we were never here
                    478:       return '';
                    479:     } else {
                    480:       $Apache::lonhomework::results{"resource.$id.previous"} = '0';
1.40      albertel  481:     }
1.85      albertel  482:   } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~
                    483: 	    /^correct/ ) {
                    484:       #delete all data as they student already has it correct
1.87      albertel  485:       &removealldata($id);
1.85      albertel  486:       #and since they didn't do anything we were never here
                    487:       return '';
1.43      albertel  488:   }
                    489:   $Apache::lonhomework::results{"resource.$id.award"} = $award;
1.10      albertel  490: }
                    491: 
1.9       albertel  492: sub grade {
1.43      albertel  493:   my ($target) = @_;
                    494:   my $id = $Apache::inputtags::part;
                    495:   my $response='';
                    496:   if ( defined $ENV{'form.submitted'}) {
                    497:     my @awards = ();
                    498:     foreach $response (@Apache::inputtags::responselist) {
                    499:       &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
                    500:       my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
1.54      albertel  501:       &Apache::lonxml::debug("keeping $value from $response for $id");
                    502:       push (@awards,$value);
1.43      albertel  503:     }
                    504:     my $finalaward = &finalizeawards(@awards);
                    505:     my $previously_used;
                    506:     if ( $#Apache::inputtags::previous eq $#awards ) {
1.75      albertel  507: 	my $match=0;
                    508: 	my @matches;
                    509: 	foreach my $versionar (@Apache::inputtags::previous_version) {
                    510: 	    foreach my $version (@$versionar) {
                    511: 		$matches[$version]++;
                    512: 	    }
                    513: 	}
                    514: 	foreach my $elem (@matches) {if ($elem eq ($#awards+1)) {$match=1;}}
                    515: 	if ($match) {
                    516: 	    $previously_used = 'PREVIOUSLY_LAST';
                    517: 	    foreach my $value (@Apache::inputtags::previous) {
                    518: 		if ($value eq 'PREVIOUSLY_USED' ) {
                    519: 		    $previously_used = $value;
                    520: 		    last;
                    521: 		}
                    522: 	    }
1.43      albertel  523: 	}
                    524:     }
                    525:     &Apache::lonxml::debug("final award $finalaward, $previously_used");
                    526:     &setgradedata($finalaward,$id,$previously_used);
                    527:   }
                    528:   return '';
1.1       albertel  529: }
                    530: 
1.11      albertel  531: sub gradestatus {
1.63      sakharuk  532:   my ($id,$target) = @_;
1.43      albertel  533:   my $showbutton = 1;
                    534:   my $message = '';
1.53      albertel  535:   my $latemessage = '';
1.43      albertel  536:   my $trystr='';
                    537:   my $button='';
                    538:   my $previousmsg='';
                    539: 
                    540:   my $status = $Apache::inputtags::status['-1'];
                    541:   &Apache::lonxml::debug("gradestatus has :$status:");
1.77      albertel  542:   if ( $status ne 'CLOSED' && $status ne 'UNAVAILABLE') {  
1.43      albertel  543:     my $award = $Apache::lonhomework::history{"resource.$id.award"};
                    544:     my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
                    545:     my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
                    546:     &Apache::lonxml::debug("Found Award |$award|$solved|");
                    547:     if ( $award ne '' ) {
                    548:       &Apache::lonxml::debug('Getting message');
                    549:       ($showbutton,$message,$previousmsg) =
1.68      sakharuk  550: 	&decideoutput($award,$solved,$previous,$target);
1.63      sakharuk  551:       if ($target eq 'tex') {
                    552: 	$message=' '.$message.' ';
                    553:       } else {
                    554: 	$message="<td bgcolor=\"#aaffaa\">$message</td>";
                    555: 	if ($previousmsg) {
                    556: 	  $previousmsg="<td bgcolor=\"#ffaaaa\">$previousmsg</td>";
                    557: 	}
1.43      albertel  558:       }
                    559:     }
                    560:     my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
                    561:     my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
                    562:     &Apache::lonxml::debug("got maxtries of :$maxtries:");
                    563:     if ( $tries eq '' ) { $tries = '0'; }
                    564:     if ( $maxtries eq '' ) { $maxtries = '2'; } 
                    565:     if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
                    566:     if ( $showbutton ) {
1.63      sakharuk  567:       if ($target eq 'tex') {
1.97      sakharuk  568: 	  if ($ENV{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam') {
                    569: 	      $trystr = ' {\vskip 1 mm \small \textit{Tries} '.$tries.'/'.$maxtries.'} \vskip 2 mm ';
1.83      sakharuk  570: 	  } else {
                    571: 	      $trystr = '\vskip 0 mm ';
1.67      sakharuk  572: 	  }
1.63      sakharuk  573:       } else {
                    574:          $trystr = "<td>Tries $tries/$maxtries</td>";
                    575:       }
1.43      albertel  576:     }
                    577:     if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}
                    578:     if ( $showbutton ) { 
1.63      sakharuk  579:       if ($target ne 'tex') {
                    580:         $button = '<br /><input type="submit" name="submit" value="Submit Answer" />';
                    581:       }
1.43      albertel  582:     }
1.53      albertel  583:     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
                    584:       #last submissions was after due date
1.63      sakharuk  585:       if ($target eq 'tex') {
                    586: 	  $latemessage=' The last submission was after the Due Date ';
                    587:       } else {
                    588:         $latemessage="<td bgcolor=\"#ffaaaa\">The last submission was after the Due Date</td>";
                    589:       }
1.53      albertel  590:     }
1.43      albertel  591:   }
1.53      albertel  592:   my $output= $previousmsg.$latemessage.$message.$trystr;
1.43      albertel  593:   if ($output =~ /^\s*$/) {
                    594:     return $button;
                    595:   } else {
1.63      sakharuk  596:     if ($target eq 'tex') {
                    597:       return $button.' \vskip 0 mm '.$output.' ';
                    598:     } else {
                    599:       return $button.'<table><tr>'.$output.'</tr></table>';
                    600:     }
1.43      albertel  601:   }
1.11      albertel  602: }
1.1       albertel  603: 1;
                    604: __END__
1.43      albertel  605:  

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