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

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

version 1.237, 2014/09/24 18:14:27 version 1.251, 2024/12/25 02:31:06
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 56  use Apache::lonnet; Line 56  use Apache::lonnet;
 use Apache::inputtags();  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 72  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 140  sub setrandomnumber { Line 141  sub setrandomnumber {
     my ($ignore_id2,$target,$rndseed) = @_;      my ($ignore_id2,$target,$rndseed) = @_;
     if (!defined($rndseed)) {      if (!defined($rndseed)) {
         $rndseed=&Apache::structuretags::setup_rndseed(undef,$target);          $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 162  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 180  sub setrandomnumber { Line 181  sub setrandomnumber {
     } else {      } else {
  ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");   ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");
     }      }
     $Apache::lonhomework::results{'resource.'.$id1.'.rawrndseed'}=$rndseed;  
     if ($rndseed =~/([,:])/) {      if ($rndseed =~/([,:])/) {
  my $char=$1;   my $char=$1;
  use integer;   use integer;
Line 197  sub setrandomnumber { Line 197  sub setrandomnumber {
  }   }
     }      }
     &Apache::lonxml::debug("randseed $rndmod $rndseed");      &Apache::lonxml::debug("randseed $rndmod $rndseed");
     $Apache::lonhomework::results{'resource.'.$id1.'.rndseed'}=$rndseed;  
     &Apache::lonnet::setup_random_from_rndseed($rndseed);      &Apache::lonnet::setup_random_from_rndseed($rndseed);
     return '';      return '';
 }  }
Line 266  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 451  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 463  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' ||              if (($award eq 'INCORRECT') || ($award eq 'APPROX_ANS') ||
                  $award eq 'EXACT_ANS')) {                  ($award eq 'EXACT_ANS') || ($award eq 'ASSIGNED_SCORE')) {
                 if ($Apache::lonhomework::type eq 'survey') {                  if ($Apache::lonhomework::type eq 'survey') {
                     $award='SUBMITTED';                      $award='SUBMITTED';
                 } elsif ($Apache::lonhomework::type eq 'surveycred') {                  } elsif ($Apache::lonhomework::type eq 'surveycred') {
Line 505  sub end_customresponse { Line 509  sub end_customresponse {
     if ($target eq 'web') {      if ($target eq 'web') {
  &setup_prior_tries_hash(\&format_prior_response_custom);   &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') {
         my $repetition = &repetition();          my $repetition = &repetition();
  &Apache::lonxml::increment_counter($repetition,"$part.$id");   &Apache::lonxml::increment_counter($repetition,"$part.$id");
Line 514  sub end_customresponse { Line 518  sub end_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 576  sub start_mathresponse { Line 583  sub start_mathresponse {
     return $result;      return $result;
 }  }
   
 sub edit_mathresponse_button {  
     my ($id,$field)=@_;  
     my $btype = $env{'browser.type'};  
     my $bversion = $env{'browser.version'};  
     if (($btype eq 'explorer' && $bversion < 9) || ($btype eq 'safari' && $bversion < 3) ||  
         ($btype eq 'mozilla' && $bversion < 3)) {  
       # DragMath applet  
       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/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  
         
     } else {  
       # LON-CAPA math equation editor  
       return(<<EQ_EDITOR_SCRIPT);  
 <script type="text/javascript">  
   var field = document.getElementById('${field}');  
   field.className += ' math'; // note the space  
   var LCMATH_started;  
   if (typeof LCMATH_started === 'undefined') {  
     LCMATH_started = true;  
     var script = document.createElement("script");  
     script.type = "text/javascript";  
     script.src = "/adm/LC_math_editor/LC_math_editor.min.js";  
     document.body.appendChild(script);  
     window.addEventListener('load', function(e) {  
         LCMATH.initEditors();  
     }, false);  
   }  
 </script>  
 EQ_EDITOR_SCRIPT  
     }  
 }  
   
 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 673  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 816  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 847  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 926  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 978  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 1012  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 1050  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
Line 1076  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 1091  sub getresponse { Line 1049  sub getresponse {
 In scalar context:  In scalar context:
   
 returns: the number of lines that are required to encode the weight.  returns: the number of lines that are required to encode the weight.
 (Default is for 10 bubbles per bubblesheet item; other (integer)   (Default is for 10 bubbles per bubblesheet item; other (integer)
 values can be specified by using a custom Bubblesheet format file   values can be specified by using a custom Bubblesheet format file
 with an eighteenth entry (BubblesPerRow) set to the integer   with an eighteenth entry (BubblesPerRow) set to the integer
 appropriate for the bubblesheets which will be used to assign weights.  appropriate for the bubblesheets which will be used to assign weights.
   
 In array context:  In array context:
    
 returns: number of lines required to encode weight, and bubbles/line.  returns: number of lines required to encode weight, and bubbles/line.
   
 =cut  =cut
Line 1107  sub repetition { Line 1065  sub repetition {
     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 $bubbles_per_row;      my $bubbles_per_row;
     if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&       if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&
         ($env{'form.bubbles_per_row'} > 0)) {          ($env{'form.bubbles_per_row'} > 0)) {
         $bubbles_per_row = $env{'form.bubbles_per_row'};          $bubbles_per_row = $env{'form.bubbles_per_row'};
     } else {      } else {
         $bubbles_per_row = 10;          $bubbles_per_row = 10;
     }      }
     my $denominator = $bubbles_per_row;      my $denominator = $bubbles_per_row;
     if (($env{'form.scantron_lastbubblepoints'} == 0) &&       if (($env{'form.scantron_lastbubblepoints'} == 0) &&
         ($bubbles_per_row > 1)) {          ($bubbles_per_row > 1)) {
         $denominator = $bubbles_per_row - 1;          $denominator = $bubbles_per_row - 1;
     }       }
     my $repetition = int($weight/$denominator);      my $repetition = int($weight/$denominator);
     if ($weight % $denominator != 0) { $repetition++; }       if ($weight % $denominator != 0) { $repetition++; }
     if (wantarray) {      if (wantarray) {
         return ($repetition,$bubbles_per_row);          return ($repetition,$bubbles_per_row);
     }      }
Line 1147  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
   
Line 1245  sub show_answer { Line 1203  sub show_answer {
         if (($Apache::lonhomework::history{"resource.$part.awarded"} >= 1) ||          if (($Apache::lonhomework::history{"resource.$part.awarded"} >= 1) ||
             (&Apache::lonnet::EXT("resource.$part.retrypartial") !~/^1|on|yes$/)) {              (&Apache::lonnet::EXT("resource.$part.retrypartial") !~/^1|on|yes$/)) {
             $canshow = 1;              $canshow = 1;
         }             }
     }      }
     return  (($canshow && &Apache::lonhomework::show_problem_status())       return  (($canshow && &Apache::lonhomework::show_problem_status())
      || $status eq "SHOW_ANSWER");       || $status eq "SHOW_ANSWER");
 }  }
   
Line 1318  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 1342  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 1357  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 1385  sub add_to_gradingqueue { Line 1343  sub add_to_gradingqueue {
     }      }
 }  }
   
 =pod   =pod
   
 =item check_status()  =item check_status()
   
Line 1393  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 1413  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 1461  sub setup_prior_tries_hash { Line 1427  sub setup_prior_tries_hash {
         }          }
     }      }
         }          }
         if ($questiontype eq 'randomizetry') {           if ($questiontype eq 'randomizetry') {
             my $order_key = "$partprefix.$id.foilorder";              my $order_key = "$partprefix.$id.foilorder";
             my @whichopts = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key});              my @whichopts = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key});
             if (@whichopts > 0) {              if (@whichopts > 0) {
Line 1481  sub setup_prior_tries_hash { Line 1447  sub setup_prior_tries_hash {
   
 1;  1;
 __END__  __END__
    
 =pod  =pod
   
 =cut  =cut
Removed from v.1.237  
changed lines
  Added in v.1.251

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