Diff for /loncom/homework/inputtags.pm between versions 1.116 and 1.174

version 1.116, 2003/09/17 21:29:44 version 1.174, 2005/08/02 18:15:27
Line 24 Line 24
 # /home/httpd/html/adm/gpl.txt  # /home/httpd/html/adm/gpl.txt
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  
 # 2/19 Guy   
   
 package Apache::inputtags;  package Apache::inputtags;
 use HTML::Entities();  use HTML::Entities();
 use strict;  use strict;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonnet;
   
 BEGIN {  BEGIN {
   &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));      &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));
 }  }
   
   
 sub initialize_inputtags {  sub initialize_inputtags {
   # list of current input ids      # list of current input ids
   @Apache::inputtags::input=();      @Apache::inputtags::input=();
   # list of all input ids seen in this problem      # list of all input ids seen in this problem
   @Apache::inputtags::inputlist=();      @Apache::inputtags::inputlist=();
   # list of all current response ids      # list of all current response ids
   @Apache::inputtags::response=();      @Apache::inputtags::response=();
   # list of all response ids seen in this problem      # list of all response ids seen in this problem
   @Apache::inputtags::responselist=();      @Apache::inputtags::responselist=();
   # list of whether or not a specific response was previously used      # list of all current hint ids
   @Apache::inputtags::previous=();      @Apache::inputtags::hint=();
   # submission it was used in      # list of all hint ids seen in this problem
   @Apache::inputtags::previous_version=();      @Apache::inputtags::hintlist=();
   # id of current part, 0 means that no part is current (inside <problem> only      # list of whether or not a specific response was previously used
   $Apache::inputtags::part='';      @Apache::inputtags::previous=();
   # list of all part ids seen      # submission it was used in
   @Apache::inputtags::partlist=();      @Apache::inputtags::previous_version=();
   # list of problem date statuses, the first element is for <problem>      # id of current part, 0 means that no part is current 
   # if there is a second element it is for the current <part>      # (inside <problem> only
   @Apache::inputtags::status=();      $Apache::inputtags::part='';
   # hash of defined params for the current response      # list of all part ids seen
   %Apache::inputtags::params=();      @Apache::inputtags::partlist=();
   # list of all ids, for <import>, these get join()ed and prepended      # list of problem date statuses, the first element is for <problem>
   @Apache::inputtags::import=();      # if there is a second element it is for the current <part>
   # list of all import ids seen      @Apache::inputtags::status=();
   @Apache::inputtags::importlist=();      # hash of defined params for the current response
       %Apache::inputtags::params=();
       # list of all ids, for <import>, these get join()ed and prepended
       @Apache::inputtags::import=();
       # list of all import ids seen
       @Apache::inputtags::importlist=();
       # just used to note whether we have seen a response that isn't in a part
       $Apache::inputtags::response_with_no_part=0;
       # storage location so the begin <*response> tag can generate the correct
       # answer string for display by the <textline />
       %Apache::inputtags::answertxt=();
 }  }
   
 sub check_for_duplicate_ids {  sub check_for_duplicate_ids {
     my %check;      my %check;
     foreach my $id (@Apache::inputtags::partlist,      foreach my $id (@Apache::inputtags::partlist,
     @Apache::inputtags::responselist,      @Apache::inputtags::responselist,
       @Apache::inputtags::hintlist,
     @Apache::inputtags::importlist) {      @Apache::inputtags::importlist) {
  $check{$id}++;   $check{$id}++;
     }      }
Line 85  sub check_for_duplicate_ids { Line 95  sub check_for_duplicate_ids {
 }  }
   
 sub start_input {  sub start_input {
   my ($parstack,$safeeval)=@_;      my ($parstack,$safeeval)=@_;
   my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);      my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
   if ($id eq '') { $id = $Apache::lonxml::curdepth; }      if ($id eq '') { $id = $Apache::lonxml::curdepth; }
   push (@Apache::inputtags::input,$id);      push (@Apache::inputtags::input,$id);
   push (@Apache::inputtags::inputlist,$id);      push (@Apache::inputtags::inputlist,$id);
   return $id;      return $id;
 }  }
   
 sub end_input {  sub end_input {
   pop @Apache::inputtags::input;      pop @Apache::inputtags::input;
   return '';      return '';
   }
   
   sub addchars {
       my ($fieldid,$addchars)=@_;
       my $output='';
       foreach (split(/\,/,$addchars)) {
    $output.='<a href="javascript:void(document.forms.lonhomework.'.
       $fieldid.'.value+=\''.$_.'\')">'.$_.'</a> ';
       }
       return $output;
 }  }
   
 sub start_textfield {  sub start_textfield {
   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   my $result = "";      my $result = "";
   my $id = &start_input($parstack,$safeeval);      my $id = &start_input($parstack,$safeeval);
   my $resid=$Apache::inputtags::response[-1];      my $resid=$Apache::inputtags::response[-1];
   if ($target eq 'web') {      if ($target eq 'web') {
     $Apache::lonxml::evaluate--;   $Apache::lonxml::evaluate--;
     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
  my $partid=$Apache::inputtags::part;      my $partid=$Apache::inputtags::part;
  my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"});      my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"},'<>&"');
  my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);      my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
  if ( $cols eq '') { $cols = 80; }      if ( $cols eq '') { $cols = 80; }
  my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);      my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
  if ( $rows eq '') { $rows = 10; }      if ( $rows eq '') { $rows = 16; }
  $result= '<textarea name="HWVAL_'.$resid.'" '.      my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
     "rows=\"$rows\" cols=\"$cols\">".$oldresponse;      $result='';
  if ($oldresponse ne '') {      if ($addchars) {
     #get rid of any startup text if the user has already responded   $result.=&addchars('HWVAL_'.$resid,$addchars);
       }
       push @Apache::lonxml::htmlareafields,'HWVAL_'.$resid;
       $result.= '<textarea wrap="hard" name="HWVAL_'.$resid.'" id="HWVAL_'.$resid.'" '.
    "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
       if ($oldresponse ne '') {
   
    #get rid of any startup text if the user has already responded
    &Apache::lonxml::get_all_text("/textfield",$parser);
       }
    } else {
       #right or wrong don't show it
       #$result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';
       $result='';
       #get rid of any startup text
     &Apache::lonxml::get_all_text("/textfield",$parser);      &Apache::lonxml::get_all_text("/textfield",$parser);
  }   }
     } else {      } elsif ($target eq 'grade') {
  #right or wrong don't show it   my $seedtext=&Apache::lonxml::get_all_text("/textfield",$parser);
  #$result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';   if ($seedtext eq $env{'form.HWVAL_'.$resid}) {
  $result='';      # if the seed text is still there it wasn't a real submission
  #get rid of any startup text      $env{'form.HWVAL_'.$resid}='';
  &Apache::lonxml::get_all_text("/textfield",$parser);   }
     }      } elsif ($target eq 'edit') {
   } elsif ($target eq 'grade') {   $result.=&Apache::edit::tag_start($target,$token);
     my $seedtext=&Apache::lonxml::get_all_text("/textfield",$parser);   $result.=&Apache::edit::text_arg('Rows:','rows',$token,4);
     if ($seedtext eq $ENV{'form.HWVAL_'.$resid}) {   $result.=&Apache::edit::text_arg('Columns:','cols',$token,4);
       # if the seed text is still there it wasn't a real submission   $result.=&Apache::edit::text_arg
       $ENV{'form.HWVAL_'.$resid}='';      ('Click-On Texts (comma sep):','addchars',$token,10);
     }   my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser);
   } elsif ($target eq 'edit') {   $result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);
     $result.=&Apache::edit::tag_start($target,$token);      } elsif ($target eq 'modified') {
     $result.=&Apache::edit::text_arg('Rows:','rows',$token,4);   my $constructtag=&Apache::edit::get_new_args($token,$parstack,
     $result.=&Apache::edit::text_arg('Columns:','cols',$token,4);       $safeeval,'rows','cols',
     my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser);       'addchars');
     $result.=&Apache::edit::editfield($token->[1],$bodytext,'Text you want to appear by default:',80,2);   if ($constructtag) {
   } elsif ($target eq 'modified') {      $result = &Apache::edit::rebuild_tag($token);
     my $constructtag=&Apache::edit::get_new_args($token,$parstack,   } else {
  $safeeval,'rows','cols');      $result=$token->[4];
     if ($constructtag) {   }
       $result = &Apache::edit::rebuild_tag($token);   $result.=&Apache::edit::modifiedfield("/textfield",$parser);
     } else {      } elsif ($target eq 'tex') {
       $result=$token->[4];   my $number_of_lines = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
    my $width_of_box = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
    if ($$tagstack[-2] eq 'essayresponse' and $Apache::lonhomework::type eq 'exam') {
       $result = '\fbox{\fbox{\parbox{\textwidth-5mm}{';
       for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
       $result.='\strut \\\\\strut \\\\\strut \\\\\strut \\\\}}}';
    } else {
       my $TeXwidth=$width_of_box/80;
       $result = '\vskip 1 mm \fbox{\fbox{\parbox{'.$TeXwidth.'\textwidth-5mm}{';
       for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}
       $result.='}}}\vskip 2 mm ';
    }
     }      }
     my $bodytext=&Apache::lonxml::get_all_text("/textfield",$parser);      return $result;
     $result.=&Apache::edit::modifiedfield();  
   } elsif ($target eq 'tex') {  
       my $number_of_lines = &Apache::lonxml::get_param('rows',$parstack,$safeeval);  
       my $width_of_box = &Apache::lonxml::get_param('cols',$parstack,$safeeval);  
       if ($$tagstack[-2] eq 'essayresponse' and $Apache::lonhomework::type eq 'exam') {  
   $result = '\fbox{\fbox{\parbox{\textwidth-5mm}{';  
   for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}  
   $result.='\strut \\\\\strut \\\\\strut \\\\\strut \\\\}}}';  
       } else {  
   my $TeXwidth=$width_of_box/80;  
   $result = '\vskip 1 mm \fbox{\fbox{\parbox{'.$TeXwidth.'\textwidth-5mm}{';  
   for (my $i=0;$i<int $number_of_lines*2;$i++) {$result.='\strut \\\\ ';}  
   $result.='}}}\vskip 2 mm ';  
       }  
   }  
   return $result;  
 }  }
   
 sub end_textfield {  sub end_textfield {
   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   my $result;      my $result;
   if ($target eq 'web') {      if ($target eq 'web') {
     $Apache::lonxml::evaluate++;   $Apache::lonxml::evaluate++;
     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
       return "</textarea>";      return "</textarea>";
     }   }
   } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
     $result=&Apache::edit::end_table();   $result=&Apache::edit::end_table();
   }      }
   &end_input;      &end_input;
   return $result;      return $result;
 }  }
   
 sub start_textline {  sub start_textline {
   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   my $result = "";      my $result = "";
   if ($target eq 'web') {      if ($target eq 'web') {
     $Apache::lonxml::evaluate--;   $Apache::lonxml::evaluate--;
     my $partid=$Apache::inputtags::part;   my $partid=$Apache::inputtags::part;
     my $id=$Apache::inputtags::response[-1];   my $id=$Apache::inputtags::response[-1];
     if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);      my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
       my $maxlength;      my $maxlength;
       if ($size eq '') { $size=20; } else {      if ($size eq '') { $size=20; } else {
  if ($size < 20) { $maxlength=$size; }   if ($size < 20) { $maxlength=$size; }
       }      }
       my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});      my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"},'<>&"');
       if ($Apache::lonhomework::type ne 'exam') {      if ($Apache::lonhomework::type ne 'exam') {
         $result= '<input type="text" name="HWVAL_'.$id.'" value="'.   my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
     $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';   $result='';
       }   if ($addchars) {
     } else {      $result.=&addchars('HWVAL_'.$id,$addchars);
       #right or wrong don't show what was last typed in.   }
       #$result='<i>'.$oldresponse.'</i>';   my $readonly=&Apache::lonxml::get_param('readonly',$parstack,
       $result='';   $safeeval);
     }   if (lc($readonly) eq 'yes') {
   } elsif ($target eq 'edit') {      $readonly=' readonly="readonly" ';
     $result=&Apache::edit::tag_start($target,$token);   } else {
     $result.=&Apache::edit::text_arg('Size:','size',$token,'5')."</td></tr>";      $readonly='';
     $result.=&Apache::edit::end_table;   }
   } elsif ($target eq 'modified') {   $result.= '<input type="text" '.$readonly.' name="HWVAL_'.$id.'" value="'.
     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size');      $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';
     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }      }
   } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') {   } else {
       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);      #right or wrong don't show what was last typed in.
       if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';}      $result='<b>'.$Apache::inputtags::answertxt{$id}.'</b>';
       $result='\framebox['.$size.'][s]{\tiny\strut}';      #$result='';
   }   }
   return $result;      } elsif ($target eq 'edit') {
    $result=&Apache::edit::tag_start($target,$token);
    $result.=&Apache::edit::text_arg('Size:','size',$token,'5').
       &Apache::edit::text_arg('Click-On Texts (comma sep):',
       'addchars',$token,10);
           $result.=&Apache::edit::select_arg('Readonly:','readonly',
      ['no','yes'],$token);
    $result.=&Apache::edit::end_row();
    $result.=&Apache::edit::end_table();
       } elsif ($target eq 'modified') {
    my $constructtag=&Apache::edit::get_new_args($token,$parstack,
        $safeeval,'size',
        'addchars','readonly');
    if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
       } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') {
    my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
    if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';}
    $result='\framebox['.$size.'][s]{\tiny\strut}';
       }
       return $result;
 }  }
   
 sub end_textline {  sub end_textline {
   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   if    ($target eq 'web') { $Apache::lonxml::evaluate++; }      if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
   elsif ($target eq 'edit') { return ('','no'); }      elsif ($target eq 'edit') { return ('','no'); }
   return "";      return "";
 }  }
   
 sub start_hiddenline {  sub start_hiddenline {
Line 232  sub start_hiddenline { Line 280  sub start_hiddenline {
  if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
     my $partid=$Apache::inputtags::part;      my $partid=$Apache::inputtags::part;
     my $id=$Apache::inputtags::response[-1];      my $id=$Apache::inputtags::response[-1];
     my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});      my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"},'<>&"');
     if ($Apache::lonhomework::type ne 'exam') {      if ($Apache::lonhomework::type ne 'exam') {
  $result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.   $result= '<input type="hidden" name="HWVAL_'.$id.'" value="'.
     $oldresponse.'" />';      $oldresponse.'" />';
Line 246  sub start_hiddenline { Line 294  sub start_hiddenline {
 }  }
   
 sub end_hiddenline {  sub end_hiddenline {
   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   if    ($target eq 'web') { $Apache::lonxml::evaluate++; }      if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
   elsif ($target eq 'edit') { return ('','no'); }      elsif ($target eq 'edit') { return ('','no'); }
   return "";      return "";
   }
   
   # $part -> partid
   # $id -> responseid
   # $uploadefiletypes -> comma seperated list of extensions allowed or * for any
   # $which -> 'uploadedonly'  -> only newly uploaded files
   #           'portfolioonly' -> only allow files from portfolio
   #           'both' -> allow files from either location
   # returns a table row <tr> 
   sub file_selector {
       my ($part,$id,$uploadedfiletypes,$which)=@_;
       if (!$uploadedfiletypes) { return ''; }
   
       my $jspart=$part;
       $jspart=~s/\./_/g;
   
       my $result;
       
       $result.='<tr><td>';
       if ($uploadedfiletypes ne '*') {
    $result.=
       &mt('Allowed filetypes: <b>[_1]</b>',$uploadedfiletypes).'<br />';
       }
       if ($which eq 'uploadonly' || $which eq 'both') { 
    $result.=&mt('Submit a file: (only one file can be uploaded)').
       ' <br /><input type="file" size="50" name="HWFILE'.
       $jspart.'_'.$id.'" /><br />';
    my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"');
   
    if ($uploadedfile) {
       my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
       push (@Apache::lonxml::extlinks,$url);
       &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);
       my $icon=&Apache::loncommon::icon($url);
       my $curfile='<a href="'.$url.'"><img src="'.$icon.
    '" border="0" />'.$uploadedfile.'</a>';
       $result.=&mt('Currently submitted: <tt>[_1]</tt>',$curfile);
    } else {
       #$result.=&mt('(Hand in a file you have prepared on your computer)');
    }
       }
       if ( $which eq 'both') { 
    $result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';
       }
       if ($which eq 'portfolioonly' || $which eq 'both') { 
    $result.='<a href='."'".'javascript:void(window.open("/adm/portfolio?mode=selectfile&amp;fieldname=HWPORT'.$jspart.'_'.$id.'","cat","height=600,width=800,scrollbars=1,resizable=1,menubar=2,location=1"))'."'".'>'.
       &mt('Select Portfolio Files').'</a><br />'.
       '<input type="text" size="50" name="HWPORT'.$jspart.'_'.$id.'" value="" />'.
       '<br />';
    if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}=~/[^\s]/){
       my @filelist;
       foreach my $file (split(',',&Apache::lonnet::unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) {
    my (undef,undef,$domain,$user)=&Apache::lonxml::whichuser();
    my $url="/uploaded/$domain/$user/portfolio$file";
    my $icon=&Apache::loncommon::icon($url);
    push(@filelist,'<a href="'.$url.'"><img src="'.$icon.
        '" border="0" />'.$file.'</a>');
       }
       $result.=&mt("Portfolio files previously selected: <strong>[_1]</strong>",join(', ',@filelist));
    }
       }
       $result.='</td></tr>'; 
       return $result;
   }
   
   sub checkstatus {
       my ($value,$awardref,$msgref)=@_;
       for (my $i=0;$i<=$#$awardref;$i++) {
    if ($$awardref[$i] eq $value) {
       return ($$awardref[$i],$$msgref[$i]);
    }
       }
       return(undef,undef);
 }  }
   
 sub finalizeawards {  sub finalizeawards {
   my $result='';      my ($awardref,$msgref)=@_;
   my $award;      my $result=undef;
   if ($#_ == '-1') { $result = "NO_RESPONSE"; }      my $award;
   if ($result eq '' ) {      my $msg;
     my $blankcount;      if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
     foreach $award (@_) {      if ($result eq '' ) {
       if ($award eq '') {   my $blankcount;
  $result='MISSING_ANSWER';   foreach $award (@$awardref) {
  $blankcount++;      if ($award eq '') {
       }   $result='MISSING_ANSWER';
     }   $blankcount++;
     if ($blankcount == ($#_ + 1)) { $result = 'NO_RESPONSE'; }      }
   }   }
   if ($result eq '' ) {   if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; }
     foreach $award (@_) { if ($award eq 'MISSING_ANSWER') {$result='MISSING_ANSWER'; last;}}      }
   }      if (defined($result)) { return ($result,$msg); }
   if ($result eq '' ) {      foreach my $possibleaward ('MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',
     foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}         'TOO_LONG', 'UNIT_INVALID_INSTRUCTOR',
   }         'UNIT_INVALID_STUDENT', 'UNIT_IRRECONCIBLE',
   if ($result eq '' ) {         'UNIT_FAIL', 'NO_UNIT',
     foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} }         'UNIT_NOTNEEDED', 'WANTED_NUMERIC',
   }         'BAD_FORMULA', 'SIG_FAIL', 'INCORRECT', 
   if ($result eq '' ) {         'MISORDERED_RANK', 'INVALID_FILETYPE',
     foreach $award (@_) { if ($award eq 'TOO_LONG') {$result='TOO_LONG'; last;}}         'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
   }         'APPROX_ANS', 'EXACT_ANS','COMMA_FAIL') {
   if ($result eq '' ) {   ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref);
     foreach $award (@_) {    if (defined($result)) { return ($result,$msg); }
       if ($award eq 'UNIT_FAIL' ||      }
   $award eq 'NO_UNIT' ||      return ('ERROR',undef);
   $award eq 'UNIT_NOTNEEDED') {  
  $result=$award; last;  
       }  
     }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) {   
       if ($award eq 'WANTED_NUMERIC' ||   
   $award eq 'BAD_FORMULA') {$result=$award; last;}  
     }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
       foreach $award (@_) { if ($award eq 'MISORDERED_RANK') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
       foreach $award (@_) { if ($award eq 'INVALID_FILETYPE') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'DRAFT') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'ASSIGNED_SCORE') {$result=$award; last;} }  
   }  
   if ($result eq '' ) {  
     foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} }  
   }  
   if ($result eq '' ) { $result='EXACT_ANS'; }  
   return $result  
 }  }
   
 sub decideoutput {  sub decideoutput {
   my ($award,$solved,$previous,$target)=@_;      my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_;
   my $message='';      my $message='';
   my $button=0;      my $button=0;
   my $previousmsg;      my $previousmsg;
   my $bgcolor='orange';      my $bgcolor='orange';
   my %possiblecolors =      my $added_computer_text=0;
       ( 'correct' => '#aaffaa',      my %possiblecolors =
  'charged_try' => '#ffaaaa',   ( 'correct' => '#aaffaa',
  'not_charged_try' => '#ffffaa',    'charged_try' => '#ffaaaa',
  'no_message' => '#fffff',    'not_charged_try' => '#ffffaa',
       );    'no_message' => '#fffff',
   if ($previous) { $previousmsg=&mt('You have entered that answer before'); }    );
   
   if      ($solved =~ /^correct/) {      if ($previous) { $previousmsg=&mt('You have entered that answer before'); }
       if ($award eq 'ASSIGNED_SCORE') {      
   $message = &mt("A score has been assigned.");      if      ($solved =~ /^correct/) {
       } else {   $bgcolor=$possiblecolors{'correct'};
   if ($target eq 'tex') {   $message=&mt('You are correct.');
       $message = '\textbf{'.&mt('You are correct.').'}';   if ($awarded < 1 && $awarded > 0) {
   } else {      $message=&mt('You are partially correct.');
       $message = "<b>".&mt('You are correct.')."</b>";      $bgcolor=$possiblecolors{'not_charged_try'};
   }   } elsif ($awarded < 1) {
           unless ($ENV{'course.'.      $message=&mt('Incorrect.');
    $ENV{'request.course.id'}.      $bgcolor=$possiblecolors{'charged_try'};
    '.disable_receipt_display'} eq 'yes') {    }
       $message.=(($target eq 'web')?'<br />':' ').   if ($env{'request.filename'} =~ 
   &mt('Your receipt is').' '.&Apache::lonnet::receipt().      m|/res/lib/templates/examupload.problem$|) {
        (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');      $message = &mt("A score has been assigned.");
   }      $added_computer_text=1;
       }   } else {
       $bgcolor=$possiblecolors{'correct'};      if ($target eq 'tex') {
       $button=0;   $message = '\textbf{'.$message.'}';
       $previousmsg='';      } else {
   } elsif ($solved =~ /^excused/) {   $message = "<b>".$message."</b>";
       if ($target eq 'tex') {   $message.=" ".&mt("Computer's answer now shown above.");
   $message = ' \textbf{'.&mt('You are excused from the problem.').'} ';      }
       } else {      $added_computer_text=1;
   $message = "<b>".&mt('You are excused from the problem.')."</b>";      unless ($env{'course.'.
       }       $env{'request.course.id'}.
       $bgcolor=$possiblecolors{'charged_try'};       '.disable_receipt_display'} eq 'yes') { 
       $button=0;   $message.=(($target eq 'web')?'<br />':' ').
       $previousmsg='';      &mt('Your receipt is').' '.&Apache::lonnet::receipt($Apache::inputtags::part).
   } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {      (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');
       if ($solved =~ /^incorrect/ || $solved eq '') {      }
   $message = &mt("Incorrect");   }
   $bgcolor=$possiblecolors{'charged_try'};   $button=0;
   $button=1;   $previousmsg='';
       } else {      } elsif ($solved =~ /^excused/) {
   $message = "<b>".&mt('You are correct.')."</b>";   if ($target eq 'tex') {
           unless ($ENV{'course.'.      $message = ' \textbf{'.&mt('You are excused from the problem.').'} ';
    $ENV{'request.course.id'}.   } else {
    '.disable_receipt_display'} eq 'yes') {       $message = "<b>".&mt('You are excused from the problem.')."</b>";
       $message.=(($target eq 'web')?'<br />':' ').   }
   'Your receipt is '.&Apache::lonnet::receipt().   $bgcolor=$possiblecolors{'charged_try'};
        (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');   $button=0;
   }   $previousmsg='';
   $bgcolor=$possiblecolors{'correct'};      } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
   $button=0;   if ($solved =~ /^incorrect/ || $solved eq '') {
   $previousmsg='';      $message = &mt("Incorrect").".";
       }      $bgcolor=$possiblecolors{'charged_try'};
   } elsif ($award eq 'NO_RESPONSE') {      $button=1;
       $message = '';   } else {
       $bgcolor=$possiblecolors{'no_feedback'};      if ($target eq 'tex') {
       $button=1;   $message = '\textbf{'.&mt('You are correct.').'}';
   } elsif ($award eq 'MISSING_ANSWER') {      } else {
       $message = &mt('Some parts were not submitted.');   $message = "<b>".&mt('You are correct.')."</b>";
       $bgcolor=$possiblecolors{'not_charged_try'};   $message.=" ".&mt("Computer's answer now shown above.");
       $button = 1;      }
   } elsif ($award eq 'ERROR') {      $added_computer_text=1;
       $message = &mt('An error occured while grading your answer.');      unless ($env{'course.'.
       $bgcolor=$possiblecolors{'not_charged_try'};       $env{'request.course.id'}.
       $button = 1;       '.disable_receipt_display'} eq 'yes') { 
   } elsif ($award eq 'TOO_LONG') {   $message.=(($target eq 'web')?'<br />':' ').
       $message = &mt("The submitted answer was too long.");      'Your receipt is '.&Apache::lonnet::receipt($Apache::inputtags::part).
       $bgcolor=$possiblecolors{'not_charged_try'};      (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):'');
       $button=1;      }
   } elsif ($award eq 'WANTED_NUMERIC') {      $bgcolor=$possiblecolors{'correct'};
       $message = &mt("This question expects a numeric answer.");      $button=0;
       $bgcolor=$possiblecolors{'not_charged_try'};      $previousmsg='';
       $button=1;   }
   } elsif ($award eq 'MISORDERED_RANK') {      } elsif ($award eq 'NO_RESPONSE') {
       $message = &mt('You have provided an invalid ranking');   $message = '';
       if ($target ne 'tex') {   $bgcolor=$possiblecolors{'no_feedback'};
   $message.=', '.&mt('please refer to').' '.&Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems').'.';   $button=1;
       }      } elsif ($award eq 'MISSING_ANSWER') {
       $bgcolor=$possiblecolors{'not_charged_try'};   $message = &mt('Some items were not submitted.');
       $button=1;   $bgcolor=$possiblecolors{'not_charged_try'};
   } elsif ($award eq 'INVALID_FILETYPE') {   $button = 1;
       $message = &mt('The filetype extension of the file you uploaded is not allowed.');      } elsif ($award eq 'ERROR') {
       $bgcolor=$possiblecolors{'not_charged_try'};   $message = &mt('An error occured while grading your answer.');
       $button=1;   $bgcolor=$possiblecolors{'not_charged_try'};
   } elsif ($award eq 'SIG_FAIL') {   $button = 1;
       $message = &mt("Please adjust significant figures.");# you provided %s significant figures";      } elsif ($award eq 'TOO_LONG') {
       $bgcolor=$possiblecolors{'not_charged_try'};   $message = &mt("The submitted answer was too long.");
       $button=1;   $bgcolor=$possiblecolors{'not_charged_try'};
   } elsif ($award eq 'UNIT_FAIL') {   $button=1;
       $message = &mt("Units incorrect.");      } elsif ($award eq 'WANTED_NUMERIC') {
       if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} #Computer reads units as %s";   $message = &mt("This question expects a numeric answer.");
       $bgcolor=$possiblecolors{'not_charged_try'};   $bgcolor=$possiblecolors{'not_charged_try'};
       $button=1;   $button=1;
   } elsif ($award eq 'UNIT_NOTNEEDED') {      } elsif ($award eq 'MISORDERED_RANK') {
       $message = &mt("Only a number required.");# Computer reads units of %s";   $message = &mt('You have provided an invalid ranking');
       $bgcolor=$possiblecolors{'not_charged_try'};   if ($target ne 'tex') {
       $button=1;      $message.=', '.&mt('please refer to').' '.&Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems');
   } elsif ($award eq 'NO_UNIT') {   }
       $message = &mt("Units required");   $bgcolor=$possiblecolors{'not_charged_try'};
       if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')};   $button=1;
       $bgcolor=$possiblecolors{'not_charged_try'};      } elsif ($award eq 'INVALID_FILETYPE') {
       $button=1;   $message = &mt('Submission won\'t be graded. The type of file submitted is not allowed.');
   } elsif ($award eq 'BAD_FORMULA') {   $bgcolor=$possiblecolors{'not_charged_try'};
       $message = &mt("Unable to understand formula");   $button=1;
       $bgcolor=$possiblecolors{'not_charged_try'};      } elsif ($award eq 'SIG_FAIL') {
       $button=1;   my ($used,$min,$max)=split(':',$awardmsg);
   } elsif ($award eq 'INCORRECT') {   my $word;
       $message = &mt("Incorrect");   if ($used < $min) { $word=&mt('more'); }
       $bgcolor=$possiblecolors{'charged_try'};   if ($used > $max) { $word=&mt('fewer'); }
       $button=1;   $message = &mt("Submission not graded.  Use [_2] digits.",$used,$word);
   } elsif ($award eq 'SUBMITTED') {   $bgcolor=$possiblecolors{'not_charged_try'};
       $message = &mt("Your submission has been recorded.");   $button=1;
       $bgcolor=$possiblecolors{'correct'};      } elsif ($award eq 'UNIT_INVALID_INSTRUCTOR') {
       $button=1;   $message = &mt('Error in instructor specifed unit. This error has been reported to the instructor.', $awardmsg);
   } elsif ($award eq 'DRAFT') {   if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
       $message = "A draft copy has been saved.";   $bgcolor=$possiblecolors{'not_charged_try'};
       $bgcolor=$possiblecolors{'not_charged_try'};   $button=1;
       $button=1;      } elsif ($award eq 'UNIT_INVALID_STUDENT') {
   } elsif ($award eq 'ASSIGNED_SCORE') {   $message = &mt('Unable to interpret units. Computer reads units as "[_1]".',&markup_unit($awardmsg,$target));
       $message = "A score has been assigned.";   if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
       $bgcolor=$possiblecolors{'correct'};   $bgcolor=$possiblecolors{'not_charged_try'};
       $button=0;   $button=1;
   } else {      } elsif ($award eq 'UNIT_FAIL' || $award eq 'UNIT_IRRECONCIBLE') {
       $message = &mt("Unknown message").": $award";   $message = &mt('Incompatible units. No conversion found between "[_1]" and the required units.',&markup_unit($awardmsg,$target));
       $button=1;   if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} 
   }   $bgcolor=$possiblecolors{'not_charged_try'};
   if (lc($Apache::lonhomework::problemstatus) eq 'no') {   $button=1;
       $message = &mt("Answer Submitted");      } elsif ($award eq 'UNIT_NOTNEEDED') {
       $bgcolor=$possiblecolors{'correct'};   $message = &mt('Only a number required. Computer reads units of "[_1]".',&markup_unit($awardmsg,$target));
       $button=1;   $bgcolor=$possiblecolors{'not_charged_try'};
   }   $button=1;
   return ($button,$bgcolor,$message,$previousmsg);      } elsif ($award eq 'NO_UNIT') {
    $message = &mt("Units required").'.';
    if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')};
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button=1;
       } elsif ($award eq 'COMMA_FAIL') {
    $message = &mt("Proper comma separation is required").'.';
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button=1;
       } elsif ($award eq 'BAD_FORMULA') {
    $message = &mt("Unable to understand formula");
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button=1;
       } elsif ($award eq 'INCORRECT') {
    $message = &mt("Incorrect").'.';
    $bgcolor=$possiblecolors{'charged_try'};
    $button=1;
       } elsif ($award eq 'SUBMITTED') {
    $message = &mt("Your submission has been recorded.");
    $bgcolor=$possiblecolors{'correct'};
    $button=1;
       } elsif ($award eq 'DRAFT') {
    $message = &mt("A draft copy has been saved.");
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button=1;
       } elsif ($award eq 'ASSIGNED_SCORE') {
    $message = &mt("A score has been assigned.");
    $bgcolor=$possiblecolors{'correct'};
    $button=0;
       } elsif ($award eq '') {
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button=1;
       } else {
    $message = &mt("Unknown message").": $award";
    $button=1;
       }
       if (lc($Apache::lonhomework::problemstatus) eq 'no'  && 
    $Apache::inputtags::status[-1] ne 'SHOW_ANSWER') {
    $message = &mt("Answer Submitted: Your final submission will be graded after the due date.");
    $bgcolor=$possiblecolors{'correct'};
    $button=1;
       }
       if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && 
    !$added_computer_text && $target ne 'tex') {
    $message.=" ".&mt("Computer's answer now shown above.");
    $added_computer_text=1;
       }
       return ($button,$bgcolor,$message,$previousmsg);
   }
   
   sub markup_unit {
       my ($unit,$target)=@_;
       if ($target eq 'tex') {
    return '\texttt{'.&Apache::lonxml::latex_special_symbols($unit).'}'; 
       } else {
    return "<tt>".$unit."</tt>";
       }
 }  }
   
 sub removealldata {  sub removealldata {
Line 473  sub removealldata { Line 613  sub removealldata {
     }      }
 }  }
   
 sub setgradedata {  sub hidealldata {
   my ($award,$id,$previously_used) = @_;      my ($id)=@_;
   # if the student already has it correct, don't modify the status      foreach my $key (keys(%Apache::lonhomework::results)) {
   if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&   if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) {
       $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {      &Apache::lonxml::debug("Hidding $key");
     $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;      my $newkey=$key;
     return '';      $newkey=~s/^(resource\.\Q$id\E\.[^\.]+\.)(.*)$/${1}hidden${2}/;
   } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~      $Apache::lonhomework::results{$newkey}=
        /^correct/ || $Apache::lonhomework::scantronmode ||   $Apache::lonhomework::results{$key};
     lc($Apache::lonhomework::problemstatus) eq 'no') {      delete($Apache::lonhomework::results{$key});
     #handle assignment of tries and solved status   }
     my $solvemsg;  
     if ($Apache::lonhomework::scantronmode) {  
  $solvemsg='correct_by_scantron';  
     } else {  
  $solvemsg='correct_by_student';  
     }      }
     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {  }
       $Apache::lonhomework::results{"resource.$id.afterduedate"}='';  
   sub setgradedata {
       my ($award,$msg,$id,$previously_used) = @_;
       if ($Apache::lonhomework::scantronmode && 
    &Apache::lonnet::validCODE($env{'form.CODE'})) {
    $Apache::lonhomework::results{"resource.CODE"}=$env{'form.CODE'};
       } elsif ($Apache::lonhomework::scantronmode && 
        $env{'form.CODE'} eq '' &&
        $Apache::lonhomework::history{"resource.CODE"} ne '') {
    $Apache::lonhomework::results{"resource.CODE"}='';
     }      }
     if ( $award eq 'ASSIGNED_SCORE') {  
  $Apache::lonhomework::results{"resource.$id.tries"} =      if (!$Apache::lonhomework::scantronmode &&
     $Apache::lonhomework::history{"resource.$id.tries"} + 1;   $Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
  $Apache::lonhomework::results{"resource.$id.solved"} =   $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') {
     $solvemsg;   $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
  my $numawards=scalar(@Apache::inputtags::response);   return '';
  $Apache::lonhomework::results{"resource.$id.awarded"} = 0;      } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~
  foreach my $res (@Apache::inputtags::response) {        /^correct/ || $Apache::lonhomework::scantronmode ||
     $Apache::lonhomework::results{"resource.$id.awarded"}+=        lc($Apache::lonhomework::problemstatus) eq 'no') {
        $Apache::lonhomework::results{"resource.$id.$res.awarded"};          # the student doesn't already have it correct,
  }   # or we are in a mode (scantron orno problem status) where a correct 
  if ($numawards > 0) {          # can become incorrect
     $Apache::lonhomework::results{"resource.$id.awarded"}/=   # handle assignment of tries and solved status
  $numawards;   my $solvemsg;
  }   if ($Apache::lonhomework::scantronmode) {
     } elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {      $solvemsg='correct_by_scantron';
       $Apache::lonhomework::results{"resource.$id.tries"} =   } else {
  $Apache::lonhomework::history{"resource.$id.tries"} + 1;      $solvemsg='correct_by_student';
       $Apache::lonhomework::results{"resource.$id.solved"} =   }
  $solvemsg;   if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
       $Apache::lonhomework::results{"resource.$id.awarded"} = '1';      $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
     } elsif ( $award eq 'INCORRECT' ) {   }
       $Apache::lonhomework::results{"resource.$id.tries"} =   if ( $award eq 'ASSIGNED_SCORE') {
  $Apache::lonhomework::history{"resource.$id.tries"} + 1;      $Apache::lonhomework::results{"resource.$id.tries"} =
       $Apache::lonhomework::results{"resource.$id.solved"} =   $Apache::lonhomework::history{"resource.$id.tries"} + 1;
  'incorrect_attempted'      $Apache::lonhomework::results{"resource.$id.solved"} =
     } elsif ( $award eq 'SUBMITTED' ) {   $solvemsg;
       $Apache::lonhomework::results{"resource.$id.tries"} =      my $numawards=scalar(@Apache::inputtags::response);
  $Apache::lonhomework::history{"resource.$id.tries"} + 1;      $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
       $Apache::lonhomework::results{"resource.$id.solved"} =      foreach my $res (@Apache::inputtags::response) {
  'ungraded_attempted';   $Apache::lonhomework::results{"resource.$id.awarded"}+=
     } elsif ( $award eq 'DRAFT' ) {      $Apache::lonhomework::results{"resource.$id.$res.awarded"};
       $Apache::lonhomework::results{"resource.$id.solved"} = '';      }
     } elsif ( $award eq 'NO_RESPONSE' ) {      if ($numawards > 0) {
  #no real response so delete any data that got stored   $Apache::lonhomework::results{"resource.$id.awarded"}/=
       $numawards;
       }
    } elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
       $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
       $Apache::lonhomework::results{"resource.$id.solved"} =
    $solvemsg;
       $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
    } elsif ( $award eq 'INCORRECT' ) {
       $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
       if (lc($Apache::lonhomework::problemstatus) eq 'no' ||
    $Apache::lonhomework::scantronmode) {
    $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
       }
       $Apache::lonhomework::results{"resource.$id.solved"} =
    'incorrect_attempted';
    } elsif ( $award eq 'SUBMITTED' ) {
       $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
       $Apache::lonhomework::results{"resource.$id.solved"} =
    'ungraded_attempted';
    } elsif ( $award eq 'DRAFT' ) {
       $Apache::lonhomework::results{"resource.$id.solved"} = '';
    } elsif ( $award eq 'NO_RESPONSE' ) {
       #no real response so delete any data that got stored
       &removealldata($id);
       return '';
    } else {
       $Apache::lonhomework::results{"resource.$id.solved"} =
    'incorrect_attempted';
       if (lc($Apache::lonhomework::problemstatus) eq 'no' ||
    $Apache::lonhomework::scantronmode) {
    $Apache::lonhomework::results{"resource.$id.tries"} =
       $Apache::lonhomework::history{"resource.$id.tries"} + 1;
    $Apache::lonhomework::results{"resource.$id.awarded"} = 0;
       }
    }
    if (defined($msg)) {
       $Apache::lonhomework::results{"resource.$id.awardmsg"} = $msg;
    }
    # did either of the overall awards chage? If so ignore the 
    # previous check
    if (($Apache::lonhomework::results{"resource.$id.awarded"} eq
        $Apache::lonhomework::history{"resource.$id.awarded"}) &&
       ($Apache::lonhomework::results{"resource.$id.solved"} eq
        $Apache::lonhomework::history{"resource.$id.solved"})) {
       # check if this was a previous submission if it was delete the
       # unneeded data and update the previously_used attribute
       if ( $previously_used eq 'PREVIOUSLY_USED') {
    if (lc($Apache::lonhomework::problemstatus) ne 'no') {
       delete($Apache::lonhomework::results{"resource.$id.tries"});
       $Apache::lonhomework::results{"resource.$id.previous"} = '1';
    }
       } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
    #delete all data as they student didn't do anything, but save
    #the list of collaborators.
    &removealldata($id);
    #and since they didn't do anything we were never here
    return '';
       } else {
    $Apache::lonhomework::results{"resource.$id.previous"} = '0';
       }
    }
       } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~
         /^correct/ ) {
    #delete all data as they student already has it correct
  &removealldata($id);   &removealldata($id);
    #and since they didn't do anything we were never here
  return '';   return '';
     } else {  
       $Apache::lonhomework::results{"resource.$id.solved"} =  
  'incorrect_attempted';  
       if (lc($Apache::lonhomework::problemstatus) eq 'no') {  
   $Apache::lonhomework::results{"resource.$id.tries"} =  
       $Apache::lonhomework::history{"resource.$id.tries"} + 1;  
       }  
     }  
   
     # check if this was a previous submission if it was delete the  
     # unneeded data and update the previously_used attribute  
     if ( $previously_used eq 'PREVIOUSLY_USED') {  
  if (lc($Apache::lonhomework::problemstatus) ne 'no') {  
     delete($Apache::lonhomework::results{"resource.$id.tries"});  
     $Apache::lonhomework::results{"resource.$id.previous"} = '1';  
  }  
     } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {  
       #delete all data as they student didn't do anything, but save  
       #the list of collaborators.  
       &removealldata($id);  
       #and since they didn't do anything we were never here  
       return '';  
     } else {  
       $Apache::lonhomework::results{"resource.$id.previous"} = '0';  
     }      }
   } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~      $Apache::lonhomework::results{"resource.$id.award"} = $award;
     /^correct/ ) {  
       #delete all data as they student already has it correct  
       &removealldata($id);  
       #and since they didn't do anything we were never here  
       return '';  
   }  
   $Apache::lonhomework::results{"resource.$id.award"} = $award;  
 }  }
   
 sub grade {  sub grade {
   my ($target) = @_;      my ($target) = @_;
   my $id = $Apache::inputtags::part;      my $id = $Apache::inputtags::part;
   my $response='';      my $response='';
   if ( defined $ENV{'form.submitted'}) {      if ( defined $env{'form.submitted'}) {
     my @awards = ();   my (@awards,@msgs);
     foreach $response (@Apache::inputtags::response) {   foreach $response (@Apache::inputtags::response) {
       &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");      &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
       my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};      my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
       &Apache::lonxml::debug("keeping $value from $response for $id");      &Apache::lonxml::debug("keeping $value from $response for $id");
       push (@awards,$value);      push (@awards,$value);
     }      $value=$Apache::lonhomework::results{"resource.$id.$response.awardmsg"};
     my $finalaward = &finalizeawards(@awards);      &Apache::lonxml::debug("got message $value from $response for $id");
     my $previously_used;      push (@msgs,$value);
     if ( $#Apache::inputtags::previous eq $#awards ) {   }
  my $match=0;   my ($finalaward,$msg) = &finalizeawards(\@awards,\@msgs);
  my @matches;   my $previously_used;
  foreach my $versionar (@Apache::inputtags::previous_version) {   if ( $#Apache::inputtags::previous eq $#awards ) {
     foreach my $version (@$versionar) {      my $match=0;
  $matches[$version]++;      my @matches;
     }      foreach my $versionar (@Apache::inputtags::previous_version) {
  }   foreach my $version (@$versionar) {
  foreach my $elem (@matches) {if ($elem eq ($#awards+1)) {$match=1;}}      $matches[$version]++;
  if ($match) {   }
     $previously_used = 'PREVIOUSLY_LAST';      }
     foreach my $value (@Apache::inputtags::previous) {      foreach my $elem (@matches) {if ($elem eq ($#awards+1)) {$match=1;}}
  if ($value eq 'PREVIOUSLY_USED' ) {      if ($match) {
     $previously_used = $value;   $previously_used = 'PREVIOUSLY_LAST';
     last;   foreach my $value (@Apache::inputtags::previous) {
       if ($value eq 'PREVIOUSLY_USED' ) {
    $previously_used = $value;
    last;
       }
  }   }
     }      }
  }   }
    &Apache::lonxml::debug("final award $finalaward, $previously_used, message $msg");
    &setgradedata($finalaward,$msg,$id,$previously_used);
     }      }
     &Apache::lonxml::debug("final award $finalaward, $previously_used");      return '';
     &setgradedata($finalaward,$id,$previously_used);  
   }  
   return '';  
 }  }
   
 sub gradestatus {  sub gradestatus {
   my ($id,$target) = @_;      my ($id,$target) = @_;
   my $showbutton = 1;      my $showbutton = 1;
   my $bgcolor = '';      my $bgcolor = '';
   my $message = '';      my $message = '';
   my $latemessage = '';      my $latemessage = '';
   my $trystr='';      my $trystr='';
   my $button='';      my $button='';
   my $previousmsg='';      my $previousmsg='';
   
   my $status = $Apache::inputtags::status['-1'];      my $status = $Apache::inputtags::status['-1'];
   &Apache::lonxml::debug("gradestatus has :$status:");      &Apache::lonxml::debug("gradestatus has :$status:");
   if ( $status ne 'CLOSED' && $status ne 'UNAVAILABLE') {        if ( $status ne 'CLOSED' && $status ne 'UNAVAILABLE' &&
     my $award = $Apache::lonhomework::history{"resource.$id.award"};   $status ne 'INVALID_ACCESS') {  
     my $solved = $Apache::lonhomework::history{"resource.$id.solved"};   my $award = $Apache::lonhomework::history{"resource.$id.award"};
     my $previous = $Apache::lonhomework::history{"resource.$id.previous"};   my $awarded = $Apache::lonhomework::history{"resource.$id.awarded"};
     &Apache::lonxml::debug("Found Award |$award|$solved|");   my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
     if ( $award ne '' || $solved ne '') {   my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
       &Apache::lonxml::debug('Getting message');   my $awardmsg = $Apache::lonhomework::history{"resource.$id.awardmsg"};
       ($showbutton,$bgcolor,$message,$previousmsg) =   &Apache::lonxml::debug("Found Award |$award|$solved|$awardmsg");
  &decideoutput($award,$solved,$previous,$target);   if ( $award ne '' || $solved ne '' || $status eq 'SHOW_ANSWER') {
       if ($target eq 'tex') {      &Apache::lonxml::debug('Getting message');
  $message=' '.$message.' ';      ($showbutton,$bgcolor,$message,$previousmsg) =
       } else {   &decideoutput($award,$awarded,$awardmsg,$solved,$previous,
  $message="<td bgcolor=\"$bgcolor\">$message</td>";        $target);
  if ($previousmsg) {      if ($target eq 'tex') {
   $previousmsg="<td bgcolor=\"#aaaaff\">$previousmsg</td>";   $message='\vskip 2 mm '.$message.' ';
  }      } else {
       }   $message="<td bgcolor=\"$bgcolor\">$message</td>";
     }   if ($previousmsg) {
     my $tries = $Apache::lonhomework::history{"resource.$id.tries"};      $previousmsg="<td bgcolor=\"#aaaaff\">$previousmsg</td>";
     my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");   }
     &Apache::lonxml::debug("got maxtries of :$maxtries:");      }
     if ( $tries eq '' ) { $tries = '0'; }   }
     if ( $maxtries eq '' ) { $maxtries = '2'; }    my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
     if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; }    my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
     if ( $showbutton ) {   &Apache::lonxml::debug("got maxtries of :$maxtries:");
       if ($target eq 'tex') {   #if tries are set to negative turn off the Tries/Button and messages
   if ($ENV{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam') {   if (defined($maxtries) && $maxtries < 0) { return ''; }
       $trystr = ' {\vskip 1 mm \small \textit{'.&mt('Tries').'} '.$tries.'/'.$maxtries.'} \vskip 2 mm ';   if ( $tries eq '' ) { $tries = '0'; }
   } else {   if ( $maxtries eq '' ) { $maxtries = '2'; } 
       $trystr = '\vskip 0 mm ';   if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
   }   my $tries_text=&mt('Tries');
       } else {   if ( $Apache::lonhomework::type eq 'survey' ||
          $trystr = "<td>".&mt('Tries')." $tries/$maxtries</td>";       $Apache::lonhomework::parsing_a_task) {
       }      $tries_text=&mt('Submissions');
     }   }
     if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}   if ( $showbutton ) {
     if ( $showbutton ) {       if ($target eq 'tex') {
       if ($target ne 'tex') {   if ($env{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam' && $env{'form.suppress_tries'} ne 'yes') {
         $button = '<br /><input type="submit" name="submit" value="'.&mt('Submit Answer').'" />';      $trystr = ' {\vskip 1 mm \small \textit{'.$tries_text.'} '.$tries.'/'.$maxtries.'} \vskip 2 mm ';
       }   } else {
     }      $trystr = '\vskip 0 mm ';
     if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {   }
       #last submissions was after due date      } else {
       if ($target eq 'tex') {   $trystr = "<td><nobr>".$tries_text." $tries";
   $latemessage=' The last submission was after the Due Date ';   if ($Apache::lonhomework::parsing_a_task) {
       } else {   } elsif($env{'request.state'} ne 'construct') {
         $latemessage="<td bgcolor=\"#ffaaaa\">The last submission was after the Due Date</td>";      $trystr.="/$maxtries";
       }   } else {
     }      if (defined($Apache::inputtags::params{'maxtries'})) {
   }   $trystr.="/".$Apache::inputtags::params{'maxtries'};
   my $output= $previousmsg.$latemessage.$message.$trystr;      }
   if ($output =~ /^\s*$/) {   }
     return $button;   $trystr.="</nobr></td>";
   } else {      }
     if ($target eq 'tex') {   }
       return $button.' \vskip 0 mm '.$output.' ';   if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}
    if ( $showbutton ) { 
       if ($target ne 'tex') {
    $button = '<input type="submit" name="submit_'.$id.'" value="'.&mt('Submit Answer').'" />';
       }
    }
    if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
       #last submissions was after due date
       $latemessage=&mt(' The last submission was after the Due Date ');;
       if ($target eq 'web') {
    $latemessage='<td bgcolor="#ffaaaa">'.$latemessage.'</td>';
       }
    }
       }
       my $output= $previousmsg.$latemessage.$message.$trystr;
       if ($output =~ /^\s*$/) {
    return $button;
     } else {      } else {
       return $button.'<table><tr>'.$output.'</tr></table>';   if ($target eq 'tex') {
       return $button.' \vskip 0 mm '.$output.' ';
    } else {
       return '<table><tr><td>'.$button.'</td>'.$output.'</tr></table>';
    }
     }      }
   }  
 }  }
 1;  1;
 __END__  __END__

Removed from v.1.116  
changed lines
  Added in v.1.174


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.