[BACK]Return to response.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/response.pm between versions 1.209 and 1.253

version 1.209, 2008/12/07 23:40:57 version 1.253, 2025/02/20 03:26:13
Line 30 Line 30
   
 =head1 NAME  =head1 NAME
   
 Apache::resonse.pm  Apache::response.pm
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
Line 42  described at http://www.lon-capa.org. Line 42  described at http://www.lon-capa.org.
   
 =over  =over
   
 =item   =item
   
 =back  =back
   
Line 53  package Apache::response; Line 53  package Apache::response;
 use strict;  use strict;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::inputtags();
 use Apache::lonmaxima();  use Apache::lonmaxima();
   use Apache::lonr();
   use Apache::lontexconvert();
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));      &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));
Line 70  sub start_response { Line 73  sub start_response {
     push (@Apache::inputtags::response,$id);      push (@Apache::inputtags::response,$id);
     push (@Apache::inputtags::responselist,$id);      push (@Apache::inputtags::responselist,$id);
     @Apache::inputtags::inputlist=();      @Apache::inputtags::inputlist=();
     if ($Apache::inputtags::part eq '' &&       if ($Apache::inputtags::part eq '' &&
  !$Apache::lonhomework::ignore_response_errors) {   !$Apache::lonhomework::ignore_response_errors) {
  &Apache::lonxml::error(&HTML::Entities::encode(&mt("Found a <*response> outside of a <part> in a <part>ed problem"),'<>&"'));   &Apache::lonxml::error(&HTML::Entities::encode(&mt("Found a <*response> outside of a <part> in a <part>ed problem"),'<>&"'));
     }      }
Line 135  sub poprandomnumber { Line 138  sub poprandomnumber {
 }  }
   
 sub setrandomnumber {  sub setrandomnumber {
     my ($ignore_id2) = @_;      my ($ignore_id2,$target,$rndseed) = @_;
     my $rndseed;      if (!defined($rndseed)) {
     $rndseed=&Apache::structuretags::setup_rndseed();          $rndseed=&Apache::structuretags::setup_rndseed(undef,$target);
       }
     if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); }      if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); }
     &Apache::lonxml::debug("randseed $rndseed");      &Apache::lonxml::debug("randseed $rndseed");
     #  $rndseed=unpack("%32i",$rndseed);      #  $rndseed=unpack("%32i",$rndseed);
Line 159  sub setrandomnumber { Line 163  sub setrandomnumber {
  } else {   } else {
     $shift_amt=0;      $shift_amt=0;
  }   }
     }       }
     &Apache::lonxml::debug("id1: $id1, id2: $id2, shift_amt: $shift_amt");      &Apache::lonxml::debug("id1: $id1, id2: $id2, shift_amt: $shift_amt");
     if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' ||      if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' ||
  $rand_alg eq '64bit2') {   $rand_alg eq '64bit2') {
Line 177  sub setrandomnumber { Line 181  sub setrandomnumber {
     } else {      } else {
  ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");   ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");
     }      }
   
     if ($rndseed =~/([,:])/) {      if ($rndseed =~/([,:])/) {
  my $char=$1;   my $char=$1;
  use integer;   use integer;
Line 239  sub meta_stores_write { Line 242  sub meta_stores_write {
       "></stores>\n";        "></stores>\n";
 }  }
   
 sub mandatory_part_meta {  
 =pod  =pod
   
 =item meta_part_order  =item mandatory_part_meta()
   
 Autogenerate metadata for mandatory  Autogenerate metadata for mandatory
 input (from RAT or lonparmset) and   input (from RAT or lonparmset) and
 output (to lonspreadsheet)  output (to lonspreadsheet)
 of each part  of each part
 #  
     return  
    &meta_parameter_write('opendate','date_start','',  
                          'Opening Date').  
    &meta_parameter_write('duedate','date_end','',  
                          'Due Date').  
    &meta_parameter_write('answerdate','date_start','',  
                          'Show Answer Date').  
    &meta_parameter_write('weight','int_zeropos','',  
                          'Available Points').  
    &meta_parameter_write('maxtries','int_pos','',  
                          'Maximum Number of Tries').  
  &meta_package_write('part').  
         &meta_stores_write('solved','string',  
    'Problem Status').  
         &meta_stores_write('tries','int_zeropos',  
    'Number of Attempts').  
         &meta_stores_write('awarded','float',  
    'Partial Credit Factor');  
   
 Note: responseid-specific data 'submission' and 'awarddetail'  Note: responseid-specific data 'submission' and 'awarddetail'
 not available to spreadsheet -> skip here  not available to spreadsheet -> skip here
   
 =cut  =cut
   
   
   sub mandatory_part_meta {
       return &meta_package_write('part').
              &meta_stores_write('solved','string','Problem Status').
              &meta_stores_write('tries','int_zeropos','Number of Attempts').
              &meta_stores_write('awarded','float','Partial Credit Factor');
 }  }
   
 sub meta_part_order {  sub meta_part_order {
       my ($type) = @_;
     if (@Apache::inputtags::partlist) {      if (@Apache::inputtags::partlist) {
  my @parts=@Apache::inputtags::partlist;   my @parts=@Apache::inputtags::partlist;
  shift(@parts);          unless ($type eq 'library') {
       shift(@parts);
           }
  return '<partorder>'.join(',',@parts).'</partorder>'."\n";   return '<partorder>'.join(',',@parts).'</partorder>'."\n";
       } elsif ($type eq 'library') {
           return '<partorder></partorder>'."\n";
     } else {      } else {
  return '<partorder>0</partorder>'."\n";   return '<partorder>0</partorder>'."\n";
     }      }
Line 293  sub meta_response_order { Line 287  sub meta_response_order {
 }  }
   
 sub check_for_previous {  sub check_for_previous {
     my ($curresponse,$partid,$id,$last) = @_;      my ($curresponse,$partid,$id,$last,$type) = @_;
     my %previous;      my %previous;
     $previous{'used'} = 0;      $previous{'used'} = 0;
       my $questiontype = $Apache::lonhomework::type;
       my $curr_rndseed = $env{'form.'.$partid.'.rndseed'};
     foreach my $key (sort(keys(%Apache::lonhomework::history))) {      foreach my $key (sort(keys(%Apache::lonhomework::history))) {
  if ($key =~ /resource\.$partid\.$id\.submission$/) {   if ($key =~ /resource\.\Q$partid\E\.\Q$id\E\.submission$/) {
     if ( $last && $key =~ /^(\d+):/ ) {      if ( $last && $key =~ /^(\d+):/ ) {
  next if ($1 >= $last);   next if ($1 >= $last);
     }      }
     &Apache::lonxml::debug("Trying $key");      &Apache::lonxml::debug("Trying $key");
     my $pastresponse=$Apache::lonhomework::history{$key};      my $pastresponse=$Apache::lonhomework::history{$key};
     if ($pastresponse eq $curresponse) {      if ($pastresponse eq $curresponse) {
  $previous{'used'} = 1;  
  my $history;   my $history;
  if ( $key =~ /^(\d+):/ ) {   if ( $key =~ /^(\d+):/ ) {
     $history=$1;                      $history=$1;
                       next if ((($questiontype eq 'randomizetry') ||
                                ($Apache::lonhomework::history{"$history:resource.$partid.type"} eq 'randomizetry')) &&
                                ($curr_rndseed ne $Apache::lonhomework::history{"$history:resource.$partid.rndseed"}));
     $previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};      $previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};
     $previous{'last'}='0';      $previous{'last'}='0';
     push(@{ $previous{'version'} },$history);      push(@{ $previous{'version'} },$history);
  } else {   } else {
                       next if ((($questiontype eq 'randomizetry') ||
                                ($Apache::lonhomework::history{"resource.$partid.type"} eq 'randomizetry')) &&
                                ($curr_rndseed ne $Apache::lonhomework::history{"resource.$partid.rndseed"}));
     $previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};      $previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};
     $previous{'last'}='1';      $previous{'last'}='1';
  }   }
                   $previous{'used'} = 1;
  if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; }   if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; }
                 if ($previous{'award'} eq 'INTERNAL_ERROR') { $previous{'used'}=0; }                  if ($previous{'award'} eq 'INTERNAL_ERROR') { $previous{'used'}=0; }
  &Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");   &Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");
     }              } elsif ($type eq 'ci') {
                   if (lc($pastresponse) eq lc($curresponse)) {
                       if ($key =~ /^(\d+):/) {
                           my $history = $1;
                           next if (($questiontype eq 'randomizetry') &&
                                ($curr_rndseed ne $Apache::lonhomework::history{"$history:resource.$partid.rndseed"}));
                           push (@{$previous{'versionci'}},$history);
                           $previous{'awardci'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};
                           $previous{'usedci'} = 1;
                       }
                   }
               }
  }   }
     }      }
     &Apache::lonhomework::showhash(%previous);      &Apache::lonhomework::showhash(%previous);
Line 331  sub handle_previous { Line 344  sub handle_previous {
  if ($$previous{'last'}) {   if ($$previous{'last'}) {
     push(@Apache::inputtags::previous,'PREVIOUSLY_LAST');      push(@Apache::inputtags::previous,'PREVIOUSLY_LAST');
     push(@Apache::inputtags::previous_version,$$previous{'version'});      push(@Apache::inputtags::previous_version,$$previous{'version'});
  } elsif ($Apache::lonhomework::type ne 'survey') {   } elsif (($Apache::lonhomework::type ne 'survey') &&
                    ($Apache::lonhomework::type ne 'surveycred') &&
                    ($Apache::lonhomework::type ne 'anonsurvey') &&
                    ($Apache::lonhomework::type ne 'anonsurveycred')) {
     push(@Apache::inputtags::previous,'PREVIOUSLY_USED');      push(@Apache::inputtags::previous,'PREVIOUSLY_USED');
     push(@Apache::inputtags::previous_version,$$previous{'version'});      push(@Apache::inputtags::previous_version,$$previous{'version'});
  }   }
Line 387  sub end_dataresponse { Line 403  sub end_dataresponse {
     $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED';      $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED';
  }   }
     } else {      } else {
  $result='Not Permitted to change values.'                  $result=&mt('Not Permitted to change values');
     }      }
  }   }
     }      }
Line 412  sub start_customresponse { Line 428  sub start_customresponse {
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token);   $result.=&Apache::edit::tag_start($target,$token);
  $result.=&Apache::edit::text_arg('String to display for answer:',   $result.=&Apache::edit::text_arg('String to display for answer:',
  'answerdisplay',$token);   'answerdisplay',$token,'50');
  $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();   $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
     } elsif ($target eq 'modified') {      } elsif ($target eq 'modified') {
  my $constructtag;   my $constructtag;
Line 439  sub end_customresponse { Line 455  sub end_customresponse {
  if ($Apache::lonhomework::type eq 'exam' ||   if ($Apache::lonhomework::type eq 'exam' ||
     &Apache::response::submitted('scantron')) {      &Apache::response::submitted('scantron')) {
     &Apache::response::scored_response($part,$id);      &Apache::response::scored_response($part,$id);
  } elsif ( $response =~ /[^\s]/ &&    } elsif ( $response =~ /[^\s]/ &&
   $Apache::response::custom_answer_type[-1] eq 'loncapa/perl') {    $Apache::response::custom_answer_type[-1] eq 'loncapa/perl') {
     if (!$Apache::lonxml::default_homework_loaded) {      if (!$Apache::lonxml::default_homework_loaded) {
  &Apache::lonxml::default_homework_load($safeeval);   &Apache::lonxml::default_homework_load($safeeval);
Line 451  sub end_customresponse { Line 467  sub end_customresponse {
     my $error;      my $error;
     ${$safeeval->varglob('LONCAPA::customresponse_submission')}=      ${$safeeval->varglob('LONCAPA::customresponse_submission')}=
  $response;   $response;
       
     my $award = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval);      my ($award,$score) = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval);
     if (!&Apache::inputtags::valid_award($award)) {      if (!&Apache::inputtags::valid_award($award)) {
  $error = $award;   $error = $award;
  $award = 'ERROR';   $award = 'ERROR';
     }      }
               if (($award eq 'INCORRECT') || ($award eq 'APPROX_ANS') ||
                   ($award eq 'EXACT_ANS') || ($award eq 'ASSIGNED_SCORE')) {
                   if ($Apache::lonhomework::type eq 'survey') {
                       $award='SUBMITTED';
                   } elsif ($Apache::lonhomework::type eq 'surveycred') {
                       $award='SUBMITTED_CREDIT';
                   } elsif ($Apache::lonhomework::type eq 'anonsurvey') {
                       $award='ANONYMOUS';
                   } elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
                       $award='ANONYMOUS_CREDIT';
                   }
               }
     &Apache::response::handle_previous(\%previous,$award);      &Apache::response::handle_previous(\%previous,$award);
     $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=      $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=
  $award;   $award;
               if ($award eq 'ASSIGNED_SCORE') {
                   $Apache::lonhomework::results{"resource.$part.$id.awarded"}=1.0*$score;
               }
     if ($error) {      if ($error) {
  $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=   $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=
     $error;      $error;
Line 476  sub end_customresponse { Line 507  sub end_customresponse {
  $result .= &Apache::response::answer_footer('customresponse');   $result .= &Apache::response::answer_footer('customresponse');
     }      }
     if ($target eq 'web') {      if ($target eq 'web') {
  &setup_prior_tries_hash(\&format_prior_response_math);   &setup_prior_tries_hash(\&format_prior_response_custom);
     }      }
     if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||       if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
  $target eq 'tex' || $target eq 'analyze') {   $target eq 'tex' || $target eq 'analyze') {
  &Apache::lonxml::increment_counter(&Apache::response::repetition(),          my $repetition = &repetition();
    "$part.$id");   &Apache::lonxml::increment_counter($repetition,"$part.$id");
  if ($target eq 'analyze') {   if ($target eq 'analyze') {
             $Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse';              $Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse';
     &Apache::lonhomework::set_bubble_lines();      &Apache::lonhomework::set_bubble_lines();
  }   }
     }      }
       if ($target eq 'web') {
           &setup_prior_tries_hash(\&format_prior_response_math);
       }
     pop(@Apache::lonxml::namespace);      pop(@Apache::lonxml::namespace);
     pop(@Apache::response::custom_answer);      pop(@Apache::response::custom_answer);
     pop(@Apache::response::custom_answer_type);      pop(@Apache::response::custom_answer_type);
Line 497  sub end_customresponse { Line 531  sub end_customresponse {
   
 sub format_prior_response_custom {  sub format_prior_response_custom {
     my ($mode,$answer) =@_;      my ($mode,$answer) =@_;
       if (ref($answer) eq 'ARRAY') {
           $answer = '('.join(', ', @{ $answer }).')';
       }
     return '<span class="LC_prior_custom">'.      return '<span class="LC_prior_custom">'.
     &HTML::Entities::encode($answer,'"<>&').'</span>';      &HTML::Entities::encode($answer,'"<>&').'</span>';
 }  }
Line 519  sub start_mathresponse { Line 556  sub start_mathresponse {
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token);   $result.=&Apache::edit::tag_start($target,$token);
  $result.=&Apache::edit::text_arg('String to display for answer:',   $result.=&Apache::edit::text_arg('String to display for answer:',
  'answerdisplay',$token);   'answerdisplay',$token,'50');
  $result.=&Apache::edit::select_arg('Algebra System:',   $result.=&Apache::edit::select_arg('Algebra System:',
    'cas',     'cas',
    ['maxima'],     ['maxima','R'],
    $token);     $token);
  $result.=&Apache::edit::text_arg('Argument Array:',   $result.=&Apache::edit::text_arg('Argument Array:',
  'args',$token).   'args',$token).
Line 546  sub start_mathresponse { Line 583  sub start_mathresponse {
     return $result;      return $result;
 }  }
   
 sub edit_mathresponse_button {  
     my ($id,$field)=@_;  
     my $button=&mt('Edit Answer');  
 #    my $helplink=&Apache::loncommon::help_open_topic('Formula_Editor');  
     my $iconpath=$Apache::lonnet::perlvar{'lonIconsURL'};  
     return(<<ENDFORMULABUTTON);  
 <script language="JavaScript">  
 function edit_${id}_${field} (textarea) {  
     thenumber = textarea;  
     thedata = document.forms['lonhomework'].elements[textarea].value;  
     newwin = window.open("/adm/dragmath/applet/MaximaPopup.html","","width=565,height=400,resizable");  
 }  
 </script>  
 <a href="javascript:edit_${id}_${field}('${field}');void(0);"><img class="stift" src='$iconpath/stift.gif' alt='$button' title='$button'/></a>  
 ENDFORMULABUTTON  
 }  
   
 sub end_mathresponse {  sub end_mathresponse {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     my $result;      my $result;
Line 586  sub end_mathresponse { Line 606  sub end_mathresponse {
                 $award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args,                  $award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args,
                                                       &Apache::lonxml::get_param('libraries',$parstack,$safeeval));                                                        &Apache::lonxml::get_param('libraries',$parstack,$safeeval));
             }              }
               if ($cas eq 'R') {
                   my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)];
                   $award=&Apache::lonr::r_run($Apache::response::custom_answer[-1],$response,$args,
                                               &Apache::lonxml::get_param('libraries',$parstack,$safeeval));
               }
   
     if (!&Apache::inputtags::valid_award($award)) {      if (!&Apache::inputtags::valid_award($award)) {
  $error = $award;   $error = $award;
  $award = 'ERROR';   $award = 'ERROR';
     }      }
               if (($award eq 'INCORRECT' || $award eq 'APPROX_ANS' ||
                    $award eq 'EXACT_ANS')) {
                   if ($Apache::lonhomework::type eq 'survey') {
                       $award='SUBMITTED';
                   } elsif ($Apache::lonhomework::type eq 'surveycred') {
                       $award='SUBMITTED_CREDIT';
                   } elsif ($Apache::lonhomework::type eq 'anonsurvey') {
                       $award='ANONYMOUS';
                   } elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
                       $award='ANONYMOUS_CREDIT';
                   }
               }
     &Apache::response::handle_previous(\%previous,$award);      &Apache::response::handle_previous(\%previous,$award);
     $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=      $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=
  $award;   $award;
Line 599  sub end_mathresponse { Line 637  sub end_mathresponse {
     }      }
  }   }
     }      }
     if ($target eq 'web') {  
  &setup_prior_tries_hash(\&format_prior_response_math);  
         my $partid = $Apache::inputtags::part;  
         my $id = $Apache::inputtags::response[-1];  
         if (($Apache::inputtags::status['-1'] eq 'CAN_ANSWER')  
            && (&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffeditor') ne 'yes')) {  
             $result.=&edit_mathresponse_button($id,"HWVAL_$id");  
         }  
     }  
   
     pop(@Apache::lonxml::namespace);      pop(@Apache::lonxml::namespace);
     pop(@Apache::response::custom_answer);      pop(@Apache::response::custom_answer);
Line 742  sub start_responseparam { Line 771  sub start_responseparam {
  }   }
     } elsif ($target eq 'grade' || $target eq 'answer' || $target eq 'web' ||      } elsif ($target eq 'grade' || $target eq 'answer' || $target eq 'web' ||
      $target eq 'tex' || $target eq 'analyze' ) {       $target eq 'tex' || $target eq 'analyze' ) {
  if ($env{'request.state'} eq 'construct') {   if (($env{'request.state'} eq 'construct') ||
       ($env{'request.noversionuri'} =~ m{^\Q/res/adm/includes/templates/\E[^/]+\.problem$})) {
     my $name   =&Apache::lonxml::get_param('name',$parstack,$safeeval);      my $name   =&Apache::lonxml::get_param('name',$parstack,$safeeval);
     my $default=&Apache::lonxml::get_param('default',$parstack,      my $default=&Apache::lonxml::get_param('default',$parstack,
      $safeeval);       $safeeval);
Line 773  sub reset_params { Line 803  sub reset_params {
 sub setup_params {  sub setup_params {
     my ($tag,$safeeval) = @_;      my ($tag,$safeeval) = @_;
   
     if ($env{'request.state'} eq 'construct') { return; }      if (($env{'request.state'} eq 'construct') ||
           ($env{'request.noversionuri'} =~ m{^\Q/res/adm/includes/templates/\E[^/]+\.problem$})) {
           return;
       }
     my %paramlist=();      my %paramlist=();
     foreach my $key (keys(%Apache::lonnet::packagetab)) {      foreach my $key (keys(%Apache::lonnet::packagetab)) {
  if ($key =~ /^\Q$tag\E/) {   if ($key =~ /^\Q$tag\E/) {
Line 815  sub answer_header { Line 848  sub answer_header {
  if ($Apache::lonhomework::type eq 'exam') {   if ($Apache::lonhomework::type eq 'exam') {
     $bit = ($Apache::lonxml::counter+$increment).') ';      $bit = ($Apache::lonxml::counter+$increment).') ';
  } else {   } else {
     $bit .= ' Answer for Part: \verb|'.              $bit .= ' '.&mt('Answer for Part: [_1]',
  $Apache::inputtags::part.'| ';                                  '\verb|'.$Apache::inputtags::part.'|').' ';
  }   }
  push(@answer_bits,$bit);   push(@answer_bits,$bit);
     } else {      } else {
  my $td = '<td '.(defined($rows)?'rowspan="'.$rows.'"':'').'>';   my $th = '<th '.(defined($rows)?'rowspan="'.$rows.'"':'').'>';
  $result  = '<table border="1"><tr>';   $result  = '<table border="1"><tr>';
  if ($Apache::lonhomework::type eq 'exam') {   if ($Apache::lonhomework::type eq 'exam') {
     $result .= $td.($Apache::lonxml::counter+$increment). ')</td>';      $result .= $th.($Apache::lonxml::counter+$increment). ')</th>';
  } else {   } else {
     $result .= $td.&mt('Answer for Part: [_1]',      $result .= $th.&mt('Answer for Part: [_1]',
        $Apache::inputtags::part).'</td>';         $Apache::inputtags::part).'</th>';
  }   }
  $result .= "\n";   $result .= "\n";
  $need_row_start = 0;   $need_row_start = 0;
Line 852  sub answer_part { Line 885  sub answer_part {
     if ($env{'form.answer_output_mode'} eq 'tex') {      if ($env{'form.answer_output_mode'} eq 'tex') {
  if (!$args->{'no_verbatim'}) {   if (!$args->{'no_verbatim'}) {
     my $to_use='|';      my $to_use='|';
     foreach my $value (32..126) {      foreach my $value (33..41,43..126) {
  my $char=pack('c',$value);   my $char=pack('c',$value);
  if ($answer !~ /\Q$char\E/) {   if ($answer !~ /\Q$char\E/) {
     $to_use=$char;      $to_use=$char;
Line 904  sub answer_footer { Line 937  sub answer_footer {
 sub showallfoils {  sub showallfoils {
     if (defined($env{'form.showallfoils'})) {      if (defined($env{'form.showallfoils'})) {
  my ($symb)=&Apache::lonnet::whichuser();   my ($symb)=&Apache::lonnet::whichuser();
  if (($env{'request.state'} eq 'construct') ||    if (($env{'request.state'} eq 'construct') ||
     ($env{'user.adv'} && $symb eq '')      ||      ($env{'user.adv'} && $symb eq '')      ||
             ($Apache::lonhomework::viewgrades) ) {              ($Apache::lonhomework::viewgrades) ) {
     return 1;      return 1;
  }   }
     }      }
     if ($Apache::lonhomework::type eq 'survey') { return 1; }      if ($Apache::lonhomework::type eq 'survey') { return 1; }
       if ($Apache::lonhomework::type eq 'surveycred') { return 1; }
       if ($Apache::lonhomework::type eq 'anonsurvey') { return 1; }
       if ($Apache::lonhomework::type eq 'anonsurveycred') { return 1; }
   
     return 0;      return 0;
 }  }
   
 =pod  =pod
   
 =item &getresponse($offset,$resulttype);  =item &getresponse();
   
 Retreives the current submitted response, helps out in the case of  Retreives the current submitted response, helps out in the case of
 scantron mode.  scantron mode.
Line 934  Optional Arguments: Line 971  Optional Arguments:
                 'A is 1' -> a number between 1 and 26                  'A is 1' -> a number between 1 and 26
                 'letter' -> a letter between 'A' and 'Z'                  'letter' -> a letter between 'A' and 'Z'
   $lines  - undef problem only needs a single line of bubbles.    $lines  - undef problem only needs a single line of bubbles.
             nonzero  Problem wants the first nonempty response in               nonzero  Problem wants the first nonempty response in
                       $lines lines of bubbles.                        $lines lines of bubbles.
   $bubbles_per_line - Must be provided if lines is defined.. number of    $bubbles_per_line - Must be provided if lines is defined.. number of
                       bubbles on a line.                        bubbles on a line.
Line 962  sub getresponse { Line 999  sub getresponse {
  my $id    = $Apache::inputtags::response[-1];   my $id    = $Apache::inputtags::response[-1];
   
  my $line;   my $line;
    my $startline = $env{'form.scantron_questnum_start.'.$part.'.'.$id};
           if (!$startline) {
               $startline = $Apache::lonxml::counter;
           }
  for ($line = 0; $line < $lines; $line++) {   for ($line = 0; $line < $lines; $line++) {
     my $theline = $Apache::lonxml::counter+$offset-1+$line;              my $theline = $startline+$offset-1+$line;
     $response = $env{"scantron.$theline.answer"};      $response = $env{"scantron.$theline.answer"};
     if ((defined($response)) && ($response ne "") && ($response ne " ")) {      if ((defined($response)) && ($response ne "") && ($response ne " ")) {
  last;   last;
     }      }
       
  }   }
   
  # save bubbled letter for later   # save bubbled letter for later
  $Apache::lonhomework::results{"resource.$part.$id.scantron"}.=   $Apache::lonhomework::results{"resource.$part.$id.scantron"}.=
     $response;      $response;
  if ($resulttype ne 'letter') {   if ($resulttype ne 'letter') {
     if ($resulttype eq 'A is 1') {              $response = $let_to_num{$response};
  $response = $let_to_num{$response}+1;              if ($resulttype eq 'A is 1') {
     } else {                  if ($response ne "") {
  $response = $let_to_num{$response};                      $response = $response+1;
                   }
     }      }
     if ($response ne "") {      if ($response ne "") {
  $response += $line * $bubbles_per_line;   $response += $line * $bubbles_per_line;
     }      }
  } else {   } else {
     if ($response ne "") {      if ($response ne "") {
                   my $raw = $response;
  $response = chr(ord($response) + $line * $bubbles_per_line);   $response = chr(ord($response) + $line * $bubbles_per_line);
     }      }
  }   }
Line 992  sub getresponse { Line 1034  sub getresponse {
     } else {      } else {
  $response = $env{$formparm};   $response = $env{$formparm};
     }      }
     #       #
     #  If we have a nonempty answer, correct the numeric value      #  If we have a nonempty answer, correct the numeric value
     #  of the answer for the line on which it was found.      #  of the answer for the line on which it was found.
     #      #
Line 1004  sub getresponse { Line 1046  sub getresponse {
   
 =item &repetition();  =item &repetition();
   
 Returns the number of lines that are required to encode the weight.  In scalar context:
 (Currently expects that there are 10 bubbles per line)  
   returns: the number of lines that are required to encode the weight.
   (Default is for 10 bubbles per bubblesheet item; other (integer)
   values can be specified by using a custom Bubblesheet format file
   with an eighteenth entry (BubblesPerRow) set to the integer
   appropriate for the bubblesheets which will be used to assign weights.
   
   In array context:
   
   returns: number of lines required to encode weight, and bubbles/line.
   
 =cut  =cut
   
Line 1013  sub repetition { Line 1064  sub repetition {
     my $id = $Apache::inputtags::part;      my $id = $Apache::inputtags::part;
     my $weight = &Apache::lonnet::EXT("resource.$id.weight");      my $weight = &Apache::lonnet::EXT("resource.$id.weight");
     if (!defined($weight) || ($weight eq '')) { $weight=1; }      if (!defined($weight) || ($weight eq '')) { $weight=1; }
     my $repetition = int($weight/10);      my $bubbles_per_row;
     if ($weight % 10 != 0) { $repetition++; }       if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&
           ($env{'form.bubbles_per_row'} > 0)) {
           $bubbles_per_row = $env{'form.bubbles_per_row'};
       } else {
           $bubbles_per_row = 10;
       }
       my $denominator = $bubbles_per_row;
       if (($env{'form.scantron_lastbubblepoints'} == 0) &&
           ($bubbles_per_row > 1)) {
           $denominator = $bubbles_per_row - 1;
       }
       my $repetition = int($weight/$denominator);
       if ($weight % $denominator != 0) { $repetition++; }
       if (wantarray) {
           return ($repetition,$bubbles_per_row);
       }
     return $repetition;      return $repetition;
   
 }  }
   
 =pod  =pod
   
 =item &scored_response($part_id,$response_id);  =item &scored_response();
   
 Sets the results hash elements  Sets the results hash elements
   
Line 1038  Arguments Line 1105  Arguments
   
    $part_id - id of the part to grade     $part_id - id of the part to grade
    $response_id - id of the response to grade     $response_id - id of the response to grade
     
   
 =cut  =cut
   
 sub scored_response {  sub scored_response {
     my ($part,$id)=@_;      my ($part,$id)=@_;
     my $repetition=&repetition();      my $repetition=&repetition();
       my $bubbles_per_row;
       if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&
           ($env{'form.bubbles_per_row'} > 0)) {
           $bubbles_per_row = $env{'form.bubbles_per_row'};
       } else {
           $bubbles_per_row = 10;
       }
     my $score=0;      my $score=0;
     for (my $i=0;$i<$repetition;$i++) {      for (my $i=0;$i<$repetition;$i++) {
  # A is 1, B is 2, etc. (get response return 0-9 and then we add 1)   # A is 1, B is 2, etc.
  my $increase=&Apache::response::getresponse($i+1);   my $increase=&Apache::response::getresponse($i+1);
  if ($increase ne '') { $score+=$increase+1; }          unless (($increase == $bubbles_per_row-1) &&
                   ($env{'form.scantron_lastbubblepoints'} == 0)) {
               # (get response return 0-9 and then we add 1)
               if ($increase ne '') {
                   $score+=$increase+1;
               }
           }
     }      }
     my $weight = &Apache::lonnet::EXT("resource.$part.weight");      my $weight = &Apache::lonnet::EXT("resource.$part.weight");
     if (!defined($weight) || $weight eq '' || $weight eq 0) { $weight = 1; }      if (!defined($weight) || $weight eq '' || $weight eq 0) { $weight = 1; }
Line 1061  sub scored_response { Line 1141  sub scored_response {
 }  }
   
 sub whichorder {  sub whichorder {
     my ($max,$randomize,$showall,$hash)=@_;      my ($max,$randomize,$showall,$hash,$rndseed)=@_;
     #&Apache::lonxml::debug("man $max randomize $randomize");      #&Apache::lonxml::debug("man $max randomize $randomize");
     if (!defined(@{ $$hash{'names'} })) { return; }      my @names;
     my @names = @{ $$hash{'names'} };      if (ref($hash->{'names'}) eq 'ARRAY') {
           @names = @{$hash->{'names'}};
       }
       return if (!@names);
     my @whichopt =();      my @whichopt =();
     my (%top,@toplist,%bottom,@bottomlist);      my (%top,@toplist,%bottom,@bottomlist);
     if (!($showall || ($randomize eq 'no'))) {      if (!($showall || ($randomize eq 'no'))) {
Line 1115  sub show_answer { Line 1198  sub show_answer {
     my $part   = $Apache::inputtags::part;      my $part   = $Apache::inputtags::part;
     my $award  = $Apache::lonhomework::history{"resource.$part.solved"};      my $award  = $Apache::lonhomework::history{"resource.$part.solved"};
     my $status = $Apache::inputtags::status[-1];      my $status = $Apache::inputtags::status[-1];
     return  ( ($award =~ /^correct/      my $canshow = 0;
        && &Apache::lonhomework::show_problem_status())      if ($award =~ /^correct/) {
       || $status eq "SHOW_ANSWER");          if (($Apache::lonhomework::history{"resource.$part.awarded"} >= 1) ||
               (&Apache::lonnet::EXT("resource.$part.retrypartial") !~/^1|on|yes$/)) {
               $canshow = 1;
           }
       }
       return  (($canshow && &Apache::lonhomework::show_problem_status())
        || $status eq "SHOW_ANSWER");
 }  }
   
 sub analyze_store_foilgroup {  sub analyze_store_foilgroup {
Line 1145  sub check_if_computed { Line 1234  sub check_if_computed {
   
 sub pick_foil_for_concept {  sub pick_foil_for_concept {
     my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_;      my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_;
     if (not defined(@{ $Apache::response::conceptgroup{'names'} })) { return; }      my @names;
     my @names = @{ $Apache::response::conceptgroup{'names'} };      if (ref($Apache::response::conceptgroup{'names'}) eq 'ARRAY') {
           @names = @{ $Apache::response::conceptgroup{'names'} };
       }
       return if (!@names);
     my $pick=int(&Math::Random::random_uniform() * ($#names+1));      my $pick=int(&Math::Random::random_uniform() * ($#names+1));
     my $name=$names[$pick];      my $name=$names[$pick];
     push @{ $Apache::response::foilgroup{'names'} }, $name;      push @{ $Apache::response::foilgroup{'names'} }, $name;
Line 1184  sub pick_foil_for_concept { Line 1276  sub pick_foil_for_concept {
   
 Get a parameter associated with a problem.  Get a parameter associated with a problem.
 Parameters:  Parameters:
  $id        - the id of the paramater, either a part id,    $id        - the id of the paramater, either a part id,
               or a partid and responspe id joined by _                or a partid and responspe id joined by _
  $name      - Name of the parameter to fetch   $name      - Name of the parameter to fetch
  $default   - Default value for the paramter.   $default   - Default value for the paramter.
Line 1208  sub get_response_param { Line 1300  sub get_response_param {
   
 sub submitted {  sub submitted {
     my ($who)=@_;      my ($who)=@_;
       
     # when scatron grading any submission is a submission      # when scatron grading any submission is a submission
     if ($env{'form.submitted'} eq 'scantron') { return 1; }      if ($env{'form.submitted'} eq 'scantron') { return 1; }
     # if the caller only cared if this was a scantron submission      # if the caller only cared if this was a scantron submission
Line 1223  sub submitted { Line 1315  sub submitted {
  return 1;   return 1;
     }      }
     # Submit All button on a .page was pressed      # Submit All button on a .page was pressed
     if (defined($env{'form.all_submit'})) { return 1; }      if ($env{'form.all_submit'}) { return 1; }
     # otherwise no submission occurred      # otherwise no submission occurred
     return 0;      return 0;
 }  }
Line 1251  sub add_to_gradingqueue { Line 1343  sub add_to_gradingqueue {
     }      }
 }  }
   
 =pod   =pod
   
 =item check_status()  =item check_status()
   
Line 1259  basically undef and 0 (both false) mean Line 1351  basically undef and 0 (both false) mean
 and all true values mean that they can't do any more work  and all true values mean that they can't do any more work
   
  a return of undef means it is unattempted   a return of undef means it is unattempted
  a return of 0 means it is attmpted and wrong but still has tries   a return of 0 means it is both attempted and still has tries and
                         is wrong or is only partially correct, and retries
                         are allowed.
  a return of 1 means it is marked correct   a return of 1 means it is marked correct
  a return of 2 means they have exceed maximum number of tries   a return of 2 means they have exceeded maximum number of tries
  a return of 3 means it after the answer date   a return of 3 means it is after the answer date
   
 =cut  =cut
   
Line 1271  sub check_status { Line 1365  sub check_status {
     if (!defined($id)) { $id=$Apache::inputtags::part; }      if (!defined($id)) { $id=$Apache::inputtags::part; }
     my $curtime=&Apache::lonnet::EXT('system.time');      my $curtime=&Apache::lonnet::EXT('system.time');
     my $opendate=&Apache::lonnet::EXT("resource.$id.opendate");      my $opendate=&Apache::lonnet::EXT("resource.$id.opendate");
     my $duedate=&Apache::lonnet::EXT("resource.$id.duedate");      my $duedate=&Apache::lonhomework::due_date($id);
     my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate");      my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate");
     if ( $opendate && $curtime > $opendate &&      if ( $opendate && $curtime > $opendate &&
          $duedate && $curtime > $duedate &&           $duedate && $curtime > $duedate &&
Line 1279  sub check_status { Line 1373  sub check_status {
         return 3;          return 3;
     }      }
     my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved");      my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved");
     if ($status =~ /^correct/) { return 1; }      if ($status =~ /^correct/) {
           my $awarded=&Apache::lonnet::EXT("user.resource.resource.$id.awarded");
           my $retrypartial=&Apache::lonnet::EXT("resource.$id.retrypartial");
           unless (($retrypartial =~ /^1|on|yes$/) && ($awarded <1))  {
               return 1;
           }
       }
     if (!$status) { return undef; }      if (!$status) { return undef; }
     my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries");      my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries");
     if ($maxtries eq '') { $maxtries=2; }      if ($maxtries eq '') { $maxtries=2; }
Line 1290  sub check_status { Line 1390  sub check_status {
   
 =pod  =pod
   
 =item setup_prior_tries_hash($func,$data)  =item setup_prior_tries_hash()
   
   Foreach each past .submission $func is called with 3 arguments    Foreach each past .submission $func is called with 3 arguments
      - the mode to set things up for (currently always 'grade')       - the mode to set things up for (currently always 'grade')
Line 1301  sub check_status { Line 1401  sub check_status {
     - scalars that are other elements of the history hash to pass to $func      - scalars that are other elements of the history hash to pass to $func
     - ref to data to be passed untouched to $func      - ref to data to be passed untouched to $func
   
     $questiontype is the questiontype (currently only passed in if
         randomizebytry.
   
 =cut  =cut
   
 sub setup_prior_tries_hash {  sub setup_prior_tries_hash {
     my ($func,$data) = @_;      my ($func,$data,$questiontype) = @_;
     my $part = $Apache::inputtags::part;      my $part = $Apache::inputtags::part;
     my $id   = $Apache::inputtags::response[-1];      my $id   = $Apache::inputtags::response[-1];
     foreach my $i (1..$Apache::lonhomework::history{'version'}) {      foreach my $i (1..$Apache::lonhomework::history{'version'}) {
  my $sub_key   = "$i:resource.$part.$id.submission";          my $partprefix = "$i:resource.$part";
    my $sub_key   = "$partprefix.$id.submission";
  next if (!exists($Apache::lonhomework::history{$sub_key}));   next if (!exists($Apache::lonhomework::history{$sub_key}));
           my $type_key = "$partprefix.type";
           my $type = $Apache::lonhomework::history{$type_key};
  my @other_data;   my @other_data;
  foreach my $datum (@{ $data }) {          if (ref($data) eq 'ARRAY') {
     if (ref($datum)) {      foreach my $datum (@{ $data }) {
  push(@other_data,$datum);          if (ref($datum)) {
     } else {      push(@other_data,$datum);
  my $info_key = "$i:resource.$part.$id.$datum";          } else {
  push(@other_data,$Apache::lonhomework::history{$info_key});      my $info_key = "$i:resource.$part.$id.$datum";
       push(@other_data,$Apache::lonhomework::history{$info_key});
           }
     }      }
  }          }
           if ($questiontype eq 'randomizetry') {
               my $order_key = "$partprefix.$id.foilorder";
               my @whichopts = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key});
               if (@whichopts > 0) {
                   shift(@other_data);
                   unshift(@other_data,\@whichopts);
               }
           }
  my $output =   my $output =
     &$func('grade',      &$func('grade',
    $Apache::lonhomework::history{$sub_key},     $Apache::lonhomework::history{$sub_key},
Line 1332  sub setup_prior_tries_hash { Line 1447  sub setup_prior_tries_hash {
   
 1;  1;
 __END__  __END__
    
 =pod  
   
 =back  =pod
   
 =cut  =cut
Removed from v.1.209  
changed lines
  Added in v.1.253

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