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

Diff for /loncom/homework/response.pm between versions 1.217 and 1.251

version 1.217, 2010/02/28 23:44:36 version 1.251, 2024/12/25 02:31:06
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::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 71  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 136  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 160  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 178  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 263  sub mandatory_part_meta { Line 265  sub mandatory_part_meta {
 }  }
   
 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 280  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\.\Q$partid\E\.\Q$id\E\.submission$/) {   if ($key =~ /resource\.\Q$partid\E\.\Q$id\E\.submission$/) {
     if ( $last && $key =~ /^(\d+):/ ) {      if ( $last && $key =~ /^(\d+):/ ) {
Line 291  sub check_for_previous { Line 300  sub check_for_previous {
     &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 321  sub handle_previous { Line 347  sub handle_previous {
  } elsif (($Apache::lonhomework::type ne 'survey') &&   } elsif (($Apache::lonhomework::type ne 'survey') &&
                  ($Apache::lonhomework::type ne 'surveycred') &&                   ($Apache::lonhomework::type ne 'surveycred') &&
                  ($Apache::lonhomework::type ne 'anonsurvey') &&                   ($Apache::lonhomework::type ne 'anonsurvey') &&
                  ($Apache::lonhomework::type ne 'anonsurveycred')) {                    ($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 377  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 402  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 429  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 441  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,$score) = &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;
Line 469  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 490  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 512  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','R'],     ['maxima','R'],
Line 539  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 type="text/javascript" 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 589  sub end_mathresponse { Line 616  sub end_mathresponse {
  $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 598  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 741  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 772  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 814  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 {
Line 851  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 903  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;
Line 937  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 975  sub getresponse { Line 1009  sub getresponse {
     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 999  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 1011  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 1020  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
Line 1045  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 1068  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 1122  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 1152  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 1191  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 1215  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 1230  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 1258  sub add_to_gradingqueue { Line 1343  sub add_to_gradingqueue {
     }      }
 }  }
   
 =pod   =pod
   
 =item check_status()  =item check_status()
   
Line 1266  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 1278  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 1286  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 1308  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 1339  sub setup_prior_tries_hash { Line 1447  sub setup_prior_tries_hash {
   
 1;  1;
 __END__  __END__
    
 =pod  =pod
   
 =cut  =cut
Removed from v.1.217  
changed lines
  Added in v.1.251

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