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

Diff for /loncom/homework/response.pm between versions 1.207 and 1.221.2.1

version 1.207, 2008/11/24 16:53:26 version 1.221.2.1, 2011/10/08 20:51:30
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   =pod
   
   =head1 NAME
   
   Apache::response.pm
   
   =head1 SYNOPSIS
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   
   =head1 NOTABLE SUBROUTINES
   
   =over
   
   =item 
   
   =back
   
   =cut
   
   
 package Apache::response;  package Apache::response;
 use strict;  use strict;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonmaxima();  use Apache::lonmaxima();
   use Apache::lonr();
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));      &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));
Line 112  sub poprandomnumber { Line 136  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 216  sub meta_stores_write { Line 241  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 {
Line 270  sub meta_response_order { Line 281  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; }
  &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 307  sub handle_previous { Line 338  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 388  sub start_customresponse { Line 422  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 428  sub end_customresponse { Line 462  sub end_customresponse {
     ${$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';
Line 436  sub end_customresponse { Line 470  sub end_customresponse {
     &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 495  sub start_mathresponse { Line 532  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 528  sub edit_mathresponse_button { Line 565  sub edit_mathresponse_button {
 #    my $helplink=&Apache::loncommon::help_open_topic('Formula_Editor');  #    my $helplink=&Apache::loncommon::help_open_topic('Formula_Editor');
     my $iconpath=$Apache::lonnet::perlvar{'lonIconsURL'};      my $iconpath=$Apache::lonnet::perlvar{'lonIconsURL'};
     return(<<ENDFORMULABUTTON);      return(<<ENDFORMULABUTTON);
 <script language="JavaScript">  <script type="text/javascript" language="JavaScript">
 function edit_${id}_${field} (textarea) {  function edit_${id}_${field} (textarea) {
     thenumber = textarea;      thenumber = textarea;
     thedata = document.forms['lonhomework'].elements[textarea].value;      thedata = document.forms['lonhomework'].elements[textarea].value;
     newwin = window.open("/adm/dragmath/applet/MaximaPopup.html","","width=565,height=400,resizable");      newwin = window.open("/adm/dragmath/applet/MaximaPopup.html","","width=565,height=400,resizable");
 }  }
 </script>  </script>
 <a href="javascript:edit_${id}_${field}('${field}');void(0);"><img class="stift" src='$iconpath/stift.gif' alt='$button' title='$button'/></a>  <a href="javascript:edit_${id}_${field}('${field}');void(0);"><img class="stift" src="$iconpath/stift.gif" alt="$button" title="$button" /></a>
 ENDFORMULABUTTON  ENDFORMULABUTTON
 }  }
   
Line 562  sub end_mathresponse { Line 599  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';
Line 887  sub showallfoils { Line 930  sub showallfoils {
  }   }
     }      }
     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 938  sub getresponse { Line 985  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
Line 996  sub repetition { Line 1047  sub repetition {
   
 =pod  =pod
   
 =item &scored_response($part_id,$response_id);  =item &scored_response();
   
 Sets the results hash elements  Sets the results hash elements
   
Line 1037  sub scored_response { Line 1088  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; }      if (!defined(@{ $$hash{'names'} })) { return; }
     my @names = @{ $$hash{'names'} };      my @names = @{ $$hash{'names'} };
Line 1153  sub pick_foil_for_concept { Line 1204  sub pick_foil_for_concept {
  $Apache::response::conceptgroup{'names'};   $Apache::response::conceptgroup{'names'};
   
 }  }
 #------------------------------------------------------------  
 #  =pod
 #  Get a parameter associated with a problem.  
 # Parameters:  =item get_response_param()
 #  $id        - the id of the paramater, either a part id,   
 #               or a partid and responspe id joined by _  Get a parameter associated with a problem.
 #  $name      - Name of the parameter to fetch  Parameters:
 #  $default   - Default value for the paramter.   $id        - the id of the paramater, either a part id, 
 #                or a partid and responspe id joined by _
 #     $name      - Name of the parameter to fetch
 #   $default   - Default value for the paramter.
   
   =cut
   
 sub get_response_param {  sub get_response_param {
     my ($id,$name,$default)=@_;      my ($id,$name,$default)=@_;
     my $parameter;      my $parameter;
Line 1224  sub add_to_gradingqueue { Line 1278  sub add_to_gradingqueue {
     }      }
 }  }
   
 # basically undef and 0 (both false) mean that they still have work to do  =pod 
 # and all true values mean that they can't do any more work  
 #  =item check_status()
 # a return of undef means it is unattempted  
 # a return of 0 means it is attmpted and wrong but still has tries  basically undef and 0 (both false) mean that they still have work to do
 # a return of 1 means it is marked correct  and all true values mean that they can't do any more work
 # a return of 2 means they have exceed maximum number of tries  
 # a return of 3 means it after the answer date   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 1 means it is marked correct
    a return of 2 means they have exceed maximum number of tries
    a return of 3 means it after the answer date
   
   =cut
   
 sub check_status {  sub check_status {
     my ($id)=@_;      my ($id)=@_;
     if (!defined($id)) { $id=$Apache::inputtags::part; }      if (!defined($id)) { $id=$Apache::inputtags::part; }
Line 1256  sub check_status { Line 1317  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 1267  sub check_status { Line 1328  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 1299  sub setup_prior_tries_hash { Line 1375  sub setup_prior_tries_hash {
 1;  1;
 __END__  __END__
     
   =pod
   
   =cut
Removed from v.1.207  
changed lines
  Added in v.1.221.2.1

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