Return to inputtags.pm CVS log

Up to [LON-CAPA] / loncom / homework

Added empty box for 'tex' output of <textline /> tag according the
bugs 919 (Lars Jensen) and 681 (Ray Batchelor). From my personal viewpoint
this may be bad idea in general though in some cases it is useful. Probably,
we have to specify somehow whet it has to be printed and to skip this tag in
other situations. By the way, I amn't sure that the chosen presentation is the
best one. Any suggestions are welcomed.

    1: # The LearningOnline Network with CAPA
    2: # input  definitons
    3: #
    4: # $Id: inputtags.pm,v 1.74 2002/11/19 14:59:35 sakharuk 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: # 2/19 Guy 
   29: 
   30: package Apache::inputtags;
   31: use HTML::Entities();
   32: use strict;
   33: 
   34: BEGIN {
   35:   &Apache::lonxml::register('Apache::inputtags',('textfield','textline'));
   36: }
   37: 
   38: 
   39: sub initialize_inputtags {
   40:   # list of current input ids
   41:   @Apache::inputtags::input=();
   42:   # list of all input ids seen in this problem
   43:   @Apache::inputtags::inputlist=();
   44:   # list of all current response ids
   45:   @Apache::inputtags::response=();
   46:   # list of all response ids seen in this problem
   47:   @Apache::inputtags::responselist=();
   48:   # list of whether or not a specific response was previously used
   49:   @Apache::inputtags::previous=();
   50:   # id of current part, 0 means that no part is current (inside <problem> only
   51:   $Apache::inputtags::part='';
   52:   # list of problem date statuses, the first element is for <problem>
   53:   # if there is a second element it is for the current <part>
   54:   @Apache::inputtags::status=();
   55:   # hash of defined params for the current response
   56:   %Apache::inputtags::params=();
   57:   # list of all ids, for <import>, these get join()ed and prepended
   58:   @Apache::inputtags::import=();
   59: }
   60: 
   61: sub start_input {
   62:   my ($parstack,$safeeval)=@_;
   63:   my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
   64:   if ($id eq '') { $id = $Apache::lonxml::curdepth; }
   65:   push (@Apache::inputtags::input,$id);
   66:   push (@Apache::inputtags::inputlist,$id);
   67:   return $id;
   68: }
   69: 
   70: sub end_input {
   71:   pop @Apache::inputtags::input;
   72:   return '';
   73: }
   74: 
   75: sub start_textfield {
   76:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   77:   my $result = "";
   78:   my $id = &start_input($parstack,$safeeval);
   79:   my $resid=$Apache::inputtags::response[-1];
   80:   if ($target eq 'web') {
   81:     $Apache::lonxml::evaluate--;
   82:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
   83: 	my $partid=$Apache::inputtags::part;
   84: 	my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"});
   85: 	my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
   86: 	if ( $cols eq '') { $cols = 80; }
   87: 	my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
   88: 	if ( $rows eq '') { $rows = 10; }
   89: 	$result= '<textarea name="HWVAL'.$resid.'" '.
   90: 	    "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
   91: 	if ($oldresponse ne '') {
   92: 	    #get rid of any startup text if the user has already responded
   93: 	    &Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
   94: 	}
   95:     } else {
   96: 	#right or wrong don't show it
   97: 	#$result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';
   98: 	$result='';
   99: 	#get rid of any startup text
  100: 	&Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
  101:     }
  102:   } elsif ($target eq 'grade') {
  103:     my $seedtext=&Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
  104:     if ($seedtext eq $ENV{'form.HWVAL'.$resid}) {
  105:       # if the seed text is still there it wasn't a real submission
  106:       $ENV{'form.HWVAL'.$resid}='';
  107:     }
  108:   } elsif ($target eq 'edit') {
  109:     $result.=&Apache::edit::tag_start($target,$token);
  110:     $result.=&Apache::edit::text_arg('Rows:','rows',$token,4);
  111:     $result.=&Apache::edit::text_arg('Columns:','cols',$token,4);
  112:     my $bodytext=&Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
  113:     $result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);
  114:   } elsif ($target eq 'modified') {
  115:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,
  116: 						 $safeeval,'rows','cols');
  117:     if ($constructtag) {
  118:       $result = &Apache::edit::rebuild_tag($token);
  119:     } else {
  120:       $result=$token->[4];
  121:     }
  122:     $result.=&Apache::edit::modifiedfield();
  123:   }
  124:   return $result;
  125: }
  126: 
  127: sub end_textfield {
  128:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  129:   my $result;
  130:   if ($target eq 'web') {
  131:     $Apache::lonxml::evaluate++;
  132:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  133:       return "</textarea>";
  134:     }
  135:   } elsif ($target eq 'edit') {
  136:     $result=&Apache::edit::end_table();
  137:   }
  138:   &end_input;
  139:   return $result;
  140: }
  141: 
  142: sub start_textline {
  143:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  144:   my $result = "";
  145:   if ($target eq 'web') {
  146:     $Apache::lonxml::evaluate--;
  147:     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  148:       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
  149:       my $maxlength;
  150:       if ($size eq '') { $size=20; } else {
  151: 	if ($size < 20) { $maxlength=$size; }
  152:       }
  153:       my $partid=$Apache::inputtags::part;
  154:       my $id=$Apache::inputtags::response[-1];
  155:       my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});
  156:       if ($Apache::lonhomework::type ne 'exam') {
  157:         $result= '<input type="text" name="HWVAL'.$id.'" value="'.
  158: 	    $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';
  159:       }
  160:     } else {
  161:       #right or wrong don't show what was last typed in.
  162:       #$result='<i>'.$oldresponse.'</i>';
  163:       $result='';
  164:     }
  165:   } elsif ($target eq 'edit') {
  166:     $result=&Apache::edit::tag_start($target,$token);
  167:     $result.=&Apache::edit::text_arg('Size:','size',$token,'5')."</td></tr>";
  168:     $result.=&Apache::edit::end_table;
  169:   } elsif ($target eq 'modified') {
  170:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size');
  171:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
  172:   } elsif ($target eq 'tex') {
  173:       $result='\framebox[1cm][s]{\hfill}';
  174:   }
  175:   return $result;
  176: }
  177: 
  178: sub end_textline {
  179:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  180:   if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
  181:   elsif ($target eq 'edit') { return ('','no'); }
  182:   return "";
  183: }
  184: 
  185: sub finalizeawards {
  186:   my $result='';
  187:   my $award;
  188:   if ($#_ == '-1') { $result = "NO_RESPONSE"; }
  189:   if ($result eq '' ) {
  190:     my $blankcount;
  191:     foreach $award (@_) {
  192:       if ($award eq '') {
  193: 	$result='MISSING_ANSWER';
  194: 	$blankcount++;
  195:       }
  196:     }
  197:     if ($blankcount == ($#_ + 1)) { $result = 'NO_RESPONSE'; }
  198:   }
  199:   if ($result eq '' ) {
  200:     foreach $award (@_) { if ($award eq 'MISSING_ANSWER') {$result='MISSING_ANSWER'; last;}}
  201:   }
  202:   if ($result eq '' ) {
  203:     foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
  204:   }
  205:   if ($result eq '' ) {
  206:     foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} }
  207:   }
  208: 
  209:   if ($result eq '' ) {
  210:     foreach $award (@_) { 
  211:       if ($award eq 'UNIT_FAIL' ||
  212: 	  $award eq 'NO_UNIT' ||
  213: 	  $award eq 'UNIT_NOTNEEDED') {
  214: 	$result=$award; last;
  215:       }
  216:     }
  217:   }
  218:   if ($result eq '' ) {
  219:     foreach $award (@_) { 
  220:       if ($award eq 'WANTED_NUMERIC' || 
  221: 	  $award eq 'BAD_FORMULA') {$result=$award; last;}
  222:     }
  223:   }
  224:   if ($result eq '' ) {
  225:     foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} }
  226:   }
  227:   if ($result eq '' ) {
  228:     foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} }
  229:   }
  230:   if ($result eq '' ) {
  231:     foreach $award (@_) { if ($award eq 'DRAFT') {$result=$award; last;} }
  232:   }
  233:   if ($result eq '' ) {
  234:     foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} }
  235:   }
  236:   if ($result eq '' ) {
  237:     foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} }
  238:   }
  239:   if ($result eq '' ) { $result='EXACT_ANS'; }
  240:   return $result
  241: }
  242: 
  243: sub decideoutput {
  244:   my ($award,$solved,$previous,$target)=@_;
  245:   my $message='';
  246:   my $button=0;
  247:   my $previousmsg;
  248: 
  249:   if ($previous) { $previousmsg='You have entered that answer before'; }
  250: 
  251:   if      ($solved =~ /^correct/) {
  252:     if ($target eq 'tex') {
  253:       $message = '\textbf{You are correct}. Your receipt is '.
  254:       &Apache::lonnet::receipt;
  255:     } else {
  256:       $message = "<b>You are correct.</b> Your receipt is ".
  257:       &Apache::lonnet::receipt;
  258:     }
  259:     $button=0;
  260:     $previousmsg='';
  261:   } elsif ($solved =~ /^excused/) {
  262:     $message = "<b>You are excused from the problem.</b>";
  263:     $button=0;
  264:     $previousmsg='';
  265:   } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
  266:     if ($solved =~ /^incorrect/ || $solved eq '') {
  267:       $message = "Incorrect";
  268:       $button=1;
  269:     } else {
  270:       $message = "<b>You are correct.</b> Your receipt is ".
  271: 	&Apache::lonnet::receipt;
  272:       $button=0;
  273:       $previousmsg='';
  274:     }
  275:   } elsif ($award eq 'NO_RESPONSE') {
  276:     $message = '';
  277:     $button=1;
  278:   } elsif ($award eq 'MISSING_ANSWER') {
  279:     $message = 'Some parts were not submitted';
  280:     $button = 1;
  281:   } elsif ($award eq 'WANTED_NUMERIC') {
  282:     $message = "This question expects a numeric answer";
  283:     $button=1;
  284:   } elsif ($award eq 'SIG_FAIL') {
  285:     $message = "Please adjust significant figures.";# you provided %s significant figures";
  286:     $button=1;
  287:   } elsif ($award eq 'UNIT_FAIL') {
  288:     $message = "Units incorrect."; #Computer reads units as %s";
  289:     $button=1;
  290:   } elsif ($award eq 'UNIT_NOTNEEDED') {
  291:     $message = "Only a number required.";# Computer reads units of %s";
  292:     $button=1;
  293:   } elsif ($award eq 'NO_UNIT') {
  294:     $message = "Units required";
  295:     $button=1;
  296:   } elsif ($award eq 'BAD_FORMULA') {
  297:     $message = "Unable to understand formula";
  298:     $button=1;
  299:   } elsif ($award eq 'INCORRECT') {
  300:     $message = "Incorrect";
  301:     $button=1;
  302:   } elsif ($award eq 'SUBMITTED') {
  303:     $message = "Your submission has been recorded.";
  304:     $button=1;
  305:   } elsif ($award eq 'DRAFT') {
  306:     $message = "A draft copy has been saved.";
  307:     $button=1;
  308:   } else {
  309:     $message = "Unknown message: $award";
  310:     $button=1;
  311:   }
  312:   return ($button,$message,$previousmsg);
  313: }
  314: 
  315: sub setgradedata {
  316:   my ($award,$id,$previously_used) = @_;
  317:   # if the student already has it correct, don't modify the status
  318:   if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
  319:       $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {
  320:     $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
  321:     return '';
  322:   } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~
  323:        /^correct/ ) {
  324:     #handle assignment of tries and solved status
  325:     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
  326:       $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
  327:     }
  328:     if ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
  329:       $Apache::lonhomework::results{"resource.$id.tries"} =
  330: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  331:       $Apache::lonhomework::results{"resource.$id.solved"} =
  332: 	'correct_by_student';
  333:       $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
  334:     } elsif ( $award eq 'INCORRECT' ) {
  335:       $Apache::lonhomework::results{"resource.$id.tries"} =
  336: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  337:       $Apache::lonhomework::results{"resource.$id.solved"} =
  338: 	'incorrect_attempted'
  339:     } elsif ( $award eq 'SUBMITTED' ) {
  340:       $Apache::lonhomework::results{"resource.$id.tries"} =
  341: 	$Apache::lonhomework::history{"resource.$id.tries"} + 1;
  342:       $Apache::lonhomework::results{"resource.$id.solved"} =
  343: 	'ungraded_attempted';
  344:     } elsif ( $award eq 'DRAFT' ) {
  345:       $Apache::lonhomework::results{"resource.$id.solved"} = '';
  346:     } elsif ( $award eq 'NO_RESPONSE' ) {
  347:       return '';
  348:     } else {
  349:       $Apache::lonhomework::results{"resource.$id.solved"} =
  350: 	'incorrect_attempted';
  351:     }
  352: 
  353:     # check if this was a previous submission if it was delete the
  354:     # unneeded data and update the previously_used attribute
  355:     if ( $previously_used eq 'PREVIOUSLY_USED') {
  356:       delete($Apache::lonhomework::results{"resource.$id.tries"});
  357:       $Apache::lonhomework::results{"resource.$id.previous"} = '1';
  358:     } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
  359:       #delete all data as they student didn't do anything, but save
  360:       #the list of collaborators.
  361:       foreach my $key (keys(%Apache::lonhomework::results)) {
  362: 	if (($key =~ /^resource\.$id\./) && ($key !~ /\.collaborators$/)) {
  363: 	  &Apache::lonxml::debug("Removing $key");
  364:   delete($Apache::lonhomework::results{$key});
  365: 	}
  366:       }
  367:       #and since they didn't do anything we were never here
  368:       return '';
  369:     } else {
  370:       $Apache::lonhomework::results{"resource.$id.previous"} = '0';
  371:     }
  372:   }
  373:   $Apache::lonhomework::results{"resource.$id.award"} = $award;
  374: }
  375: 
  376: sub grade {
  377:   my ($target) = @_;
  378:   my $id = $Apache::inputtags::part;
  379:   my $response='';
  380:   if ( defined $ENV{'form.submitted'}) {
  381:     my @awards = ();
  382:     foreach $response (@Apache::inputtags::responselist) {
  383:       &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
  384:       my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
  385:       &Apache::lonxml::debug("keeping $value from $response for $id");
  386:       push (@awards,$value);
  387:     }
  388:     my $finalaward = &finalizeawards(@awards);
  389:     my $previously_used;
  390:     if ( $#Apache::inputtags::previous eq $#awards ) {
  391:       $previously_used = 'PREVIOUSLY_LAST';
  392:       foreach my $value (@Apache::inputtags::previous) {
  393: 	if ($value eq 'PREVIOUSLY_USED' ) {
  394: 	  $previously_used = $value;
  395: 	  last;
  396: 	}
  397:       }
  398:     }
  399:     &Apache::lonxml::debug("final award $finalaward, $previously_used");
  400:     &setgradedata($finalaward,$id,$previously_used);
  401:   }
  402:   return '';
  403: }
  404: 
  405: sub gradestatus {
  406:   my ($id,$target) = @_;
  407:   my $showbutton = 1;
  408:   my $message = '';
  409:   my $latemessage = '';
  410:   my $trystr='';
  411:   my $button='';
  412:   my $previousmsg='';
  413: 
  414:   my $status = $Apache::inputtags::status['-1'];
  415:   &Apache::lonxml::debug("gradestatus has :$status:");
  416:   if ( $status ne 'CLOSED' ) {  
  417:     my $award = $Apache::lonhomework::history{"resource.$id.award"};
  418:     my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
  419:     my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
  420:     &Apache::lonxml::debug("Found Award |$award|$solved|");
  421:     if ( $award ne '' ) {
  422:       &Apache::lonxml::debug('Getting message');
  423:       ($showbutton,$message,$previousmsg) =
  424: 	&decideoutput($award,$solved,$previous,$target);
  425:       if ($target eq 'tex') {
  426: 	$message=' '.$message.' ';
  427:       } else {
  428: 	$message="<td bgcolor=\"#aaffaa\">$message</td>";
  429: 	if ($previousmsg) {
  430: 	  $previousmsg="<td bgcolor=\"#ffaaaa\">$previousmsg</td>";
  431: 	}
  432:       }
  433:     }
  434:     my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
  435:     my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
  436:     &Apache::lonxml::debug("got maxtries of :$maxtries:");
  437:     if ( $tries eq '' ) { $tries = '0'; }
  438:     if ( $maxtries eq '' ) { $maxtries = '2'; } 
  439:     if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
  440:     if ( $showbutton ) {
  441:       if ($target eq 'tex') {
  442: 	  if ($ENV{'request.state'} ne "construct") {
  443: 	      $trystr = ' {\small \textit{Tries} '.$tries.'/'.$maxtries.'} \vskip 0 mm ';
  444: 	  }
  445:       } else {
  446:          $trystr = "<td>Tries $tries/$maxtries</td>";
  447:       }
  448:     }
  449:     if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}
  450:     if ( $showbutton ) { 
  451:       if ($target ne 'tex') {
  452:         $button = '<br /><input type="submit" name="submit" value="Submit Answer" />';
  453:       }
  454:     }
  455:     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
  456:       #last submissions was after due date
  457:       if ($target eq 'tex') {
  458: 	  $latemessage=' The last submission was after the Due Date ';
  459:       } else {
  460:         $latemessage="<td bgcolor=\"#ffaaaa\">The last submission was after the Due Date</td>";
  461:       }
  462:     }
  463:   }
  464:   my $output= $previousmsg.$latemessage.$message.$trystr;
  465:   if ($output =~ /^\s*$/) {
  466:     return $button;
  467:   } else {
  468:     if ($target eq 'tex') {
  469:       return $button.' \vskip 0 mm '.$output.' ';
  470:     } else {
  471:       return $button.'<table><tr>'.$output.'</tr></table>';
  472:     }
  473:   }
  474: }
  475: 1;
  476: __END__
  477: