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

Diff for /loncom/homework/grades.pm between versions 1.596.2.12.2.4 and 1.596.2.13

version 1.596.2.12.2.4, 2012/05/02 15:28:09 version 1.596.2.13, 2012/08/09 23:25:48
Line 52  use POSIX qw(floor); Line 52  use POSIX qw(floor);
   
   
 my %perm=();  my %perm=();
   my %old_essays=();
   
 #  These variables are used to recover from ssi errors  #  These variables are used to recover from ssi errors
   
Line 260  sub showResourceInfo { Line 261  sub showResourceInfo {
 sub reset_caches {  sub reset_caches {
     &reset_analyze_cache();      &reset_analyze_cache();
     &reset_perm();      &reset_perm();
       &reset_old_essays();
 }  }
   
 {  {
Line 272  sub reset_caches { Line 274  sub reset_caches {
     }      }
   
     sub get_analyze {      sub get_analyze {
  my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_;   my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed)=@_;
  my $key = "$symb\0$uname\0$udom";   my $key = "$symb\0$uname\0$udom";
         if ($type eq 'randomizetry') {          if ($type eq 'randomizetry') {
             if ($trial ne '') {              if ($trial ne '') {
Line 306  sub reset_caches { Line 308  sub reset_caches {
                     'grade_courseid'    =>  $env{'request.course.id'},                      'grade_courseid'    =>  $env{'request.course.id'},
                     'grade_username'    => $uname,                      'grade_username'    => $uname,
                     'grade_noincrement' => $no_increment);                      'grade_noincrement' => $no_increment);
         if ($bubbles_per_row ne '') {  
             $form{'bubbles_per_row'} = $bubbles_per_row;  
         }  
         if ($type eq 'randomizetry') {          if ($type eq 'randomizetry') {
             $form{'grade_questiontype'} = $type;              $form{'grade_questiontype'} = $type;
             if ($rndseed ne '') {              if ($rndseed ne '') {
Line 349  sub reset_caches { Line 348  sub reset_caches {
     }      }
   
     sub scantron_partids_tograde {      sub scantron_partids_tograde {
         my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_;          my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_;
         my (%analysis,@parts);          my (%analysis,@parts);
         if (ref($resource)) {          if (ref($resource)) {
             my $symb = $resource->symb();              my $symb = $resource->symb();
Line 357  sub reset_caches { Line 356  sub reset_caches {
             if ($check_for_randomlist) {              if ($check_for_randomlist) {
                 $add_to_form = { 'check_parts_withrandomlist' => 1,};                  $add_to_form = { 'check_parts_withrandomlist' => 1,};
             }              }
             my $analyze =              my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form);
                 &get_analyze($symb,$uname,$udom,undef,$add_to_form,  
                              undef,undef,undef,$bubbles_per_row);  
             if (ref($analyze) eq 'HASH') {              if (ref($analyze) eq 'HASH') {
                 %analysis = %{$analyze};                  %analysis = %{$analyze};
             }              }
Line 743  sub compute_points { Line 740  sub compute_points {
 #  #
   
 sub most_similar {  sub most_similar {
     my ($uname,$udom,$uessay,$old_essays)=@_;      my ($uname,$udom,$symb,$uessay)=@_;
   
       unless ($symb) { return ''; }
   
       unless (ref($old_essays{$symb}) eq 'HASH') { return ''; }
   
 # ignore spaces and punctuation  # ignore spaces and punctuation
   
Line 760  sub most_similar { Line 761  sub most_similar {
     my $scrsid='';      my $scrsid='';
     my $sessay='';      my $sessay='';
 # go through all essays ...  # go through all essays ...
     foreach my $tkey (keys(%$old_essays)) {      foreach my $tkey (keys(%{$old_essays{$symb}})) {
  my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));   my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
 # ... except the same student  # ... except the same student
         next if (($tname eq $uname) && ($tdom eq $udom));          next if (($tname eq $uname) && ($tdom eq $udom));
  my $tessay=$old_essays->{$tkey};   my $tessay=$old_essays{$symb}{$tkey};
  $tessay=~s/\W+/ /gs;   $tessay=~s/\W+/ /gs;
 # String similarity gives up if not even limit  # String similarity gives up if not even limit
  my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);   my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
Line 774  sub most_similar { Line 775  sub most_similar {
     $sname=$tname;      $sname=$tname;
     $sdom=$tdom;      $sdom=$tdom;
     $scrsid=$tcrsid;      $scrsid=$tcrsid;
     $sessay=$old_essays->{$tkey};      $sessay=$old_essays{$symb}{$tkey};
  }   }
     }      }
     if ($limit>0.6) {      if ($limit>0.6) {
Line 1830  sub gradeBox { Line 1831  sub gradeBox {
     $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";      $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";
   
   
    #&mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line);
     $result .=       $result .= 
     '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';      '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';
     $result.=&Apache::loncommon::end_data_table_row();      $result.=&Apache::loncommon::end_data_table_row();
Line 2013  sub submission { Line 2015  sub submission {
  '" src="'.$request->dir_config('lonIconsURL').   '" src="'.$request->dir_config('lonIconsURL').
  '/check.gif" height="16" border="0" />';   '/check.gif" height="16" border="0" />';
   
     my %old_essays;  
     # header info      # header info
     if ($counter == 0) {      if ($counter == 0) {
  &sub_page_js($request);   &sub_page_js($request);
Line 2129  KEYWORDS Line 2130  KEYWORDS
     my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);      my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
     $apath=&escape($apath);      $apath=&escape($apath);
     $apath=~s/\W/\_/gs;      $apath=~s/\W/\_/gs;
     %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);      &init_old_essays($symb,$apath,$adom,$aname);
         }          }
     }      }
   
Line 2266  KEYWORDS Line 2267  KEYWORDS
                     }                      }
     if($env{'form.checkPlag'}){      if($env{'form.checkPlag'}){
  my ($oname,$odom,$ocrsid,$oessay,$osim)=   my ($oname,$odom,$ocrsid,$oessay,$osim)=
     &most_similar($uname,$udom,$subval,\%old_essays);      &most_similar($uname,$udom,$symb,$subval);
  if ($osim) {   if ($osim) {
     $osim=int($osim*100.0);      $osim=int($osim*100.0);
     my %old_course_desc =       my %old_course_desc = 
Line 3006  sub handback_files { Line 3007  sub handback_files {
         &file_name_version_ext($answer_file);          &file_name_version_ext($answer_file);
     my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);      my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
                     my $getpropath = 1;                      my $getpropath = 1;
                     my ($dir_list,$listerror) =      my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
                         &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,      my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                                                  $domain,$stuname,$getpropath);  
     my $version = &get_next_version($answer_name,$answer_ext,$dir_list);  
                     # fix file name                      # fix file name
                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);                      my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,                      my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
Line 3169  sub version_portfiles { Line 3168  sub version_portfiles {
                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);                  my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
  my ($answer_name,$answer_ver,$answer_ext) =   my ($answer_name,$answer_ver,$answer_ext) =
     &file_name_version_ext($answer_file);      &file_name_version_ext($answer_file);
                 my $getpropath = 1;                  my $getpropath = 1;    
                 my ($dir_list,$listerror) =                  my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
                     &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,                  my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                                              $stu_name,$getpropath);  
                 my $version = &get_next_version($answer_name,$answer_ext,$dir_list);  
                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);                  my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                 if ($new_answer ne 'problem getting file') {                  if ($new_answer ne 'problem getting file') {
                     push(@versioned_portfiles, $directory.$new_answer);                      push(@versioned_portfiles, $directory.$new_answer);
Line 3192  sub version_portfiles { Line 3189  sub version_portfiles {
 sub get_next_version {  sub get_next_version {
     my ($answer_name, $answer_ext, $dir_list) = @_;      my ($answer_name, $answer_ext, $dir_list) = @_;
     my $version;      my $version;
     if (ref($dir_list) eq 'ARRAY') {      foreach my $row (@$dir_list) {
         foreach my $row (@{$dir_list}) {          my ($file) = split(/\&/,$row,2);
             my ($file) = split(/\&/,$row,2);          my ($file_name,$file_version,$file_ext) =
             my ($file_name,$file_version,$file_ext) =      &file_name_version_ext($file);
         &file_name_version_ext($file);          if (($file_name eq $answer_name) && 
             if (($file_name eq $answer_name) &&       ($file_ext eq $answer_ext)) {
         ($file_ext eq $answer_ext)) {                  # gets here if filename and extension match, regardless of version
                 # gets here if filename and extension match,   
                 # regardless of version  
                 if ($file_version ne '') {                  if ($file_version ne '') {
                     # a versioned file is found  so save it for later                  # a versioned file is found  so save it for later
                     if ($file_version > $version) {                  if ($file_version > $version) {
         $version = $file_version;      $version = $file_version;
                     }  
         }          }
             }              }
         }          }
     }      } 
     $version ++;      $version ++;
     return($version);      return($version);
 }  }
Line 5168  sub scantron_filenames { Line 5162  sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
     my $getpropath = 1;      my $getpropath = 1;
     my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom,      my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
                                                         $cname,$getpropath);                                         $getpropath);
     my @possiblenames;      my @possiblenames;
     if (ref($dirlist) eq 'ARRAY') {      foreach my $filename (sort(@files)) {
         foreach my $filename (sort(@{$dirlist})) {   ($filename)=split(/&/,$filename);
     ($filename)=split(/&/,$filename);   if ($filename!~/^scantron_orig_/) { next ; }
     if ($filename!~/^scantron_orig_/) { next ; }   $filename=~s/^scantron_orig_//;
     $filename=~s/^scantron_orig_//;   push(@possiblenames,$filename);
     push(@possiblenames,$filename);  
         }  
     }      }
     return @possiblenames;      return @possiblenames;
 }  }
Line 5575  sub scantron_selectphase { Line 5567  sub scantron_selectphase {
     
       LastName    - column that the last name starts in        LastName    - column that the last name starts in
       LastNameLength - number of columns that the last name spans        LastNameLength - number of columns that the last name spans
       BubblesPerRow - number of bubbles available in each row used to  
                       bubble an answer. (If not specified, 10 assumed).  
   
 =cut  =cut
   
Line 5607  sub get_scantron_config { Line 5597  sub get_scantron_config {
  $config{'FirstNamelength'}=$config[14];   $config{'FirstNamelength'}=$config[14];
  $config{'LastName'}=$config[15];   $config{'LastName'}=$config[15];
  $config{'LastNamelength'}=$config[16];   $config{'LastNamelength'}=$config[16];
         $config{'BubblesPerRow'}=$config[17];  
  last;   last;
     }      }
     return %config;      return %config;
Line 6392  sub scantron_warning_screen { Line 6381  sub scantron_warning_screen {
     '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.      '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
     $env{'form.scantron_CODElist'}.'</tt></td></tr>';      $env{'form.scantron_CODElist'}.'</tt></td></tr>';
     }      }
     my $lastbubblepoints;  
     if ($env{'form.scantron_lastbubblepoints'} ne '') {  
         $lastbubblepoints =  
             '<tr><td><b>'.&mt('Hand-graded items: points from last bubble in row').'</b></td><td><tt>'.  
             $env{'form.scantron_lastbubblepoints'}.'</tt></td></tr>';  
     }  
     return ('      return ('
 <p>  <p>
 <span class="LC_warning">  <span class="LC_warning">
Line 6406  sub scantron_warning_screen { Line 6389  sub scantron_warning_screen {
 <table>  <table>
 <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>  <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
 <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>  <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
 '.$CODElist.$lastbubblepoints.'  '.$CODElist.'
 </table>  </table>
 <br />  <br />
 <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>  <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>
Line 6446  sub scantron_do_warning { Line 6429  sub scantron_do_warning {
  }    } 
     } else {      } else {
  my $warning=&scantron_warning_screen('Grading: Validate Records');   my $warning=&scantron_warning_screen('Grading: Validate Records');
         my $bubbledbyhand=&hand_bubble_option();  
  $r->print('   $r->print('
 '.$warning.$bubbledbyhand.'  '.$warning.'
 <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />  <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
 <input type="hidden" name="command" value="scantron_validate" />  <input type="hidden" name="command" value="scantron_validate" />
 ');  ');
Line 6538  sub scantron_validate_file { Line 6520  sub scantron_validate_file {
     #get the student pick code ready      #get the student pick code ready
     $r->print(&Apache::loncommon::studentbrowser_javascript());      $r->print(&Apache::loncommon::studentbrowser_javascript());
     my $nav_error;      my $nav_error;
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my $max_bubble=&scantron_get_maxbubble(\$nav_error);
     my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);  
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
     }      }
     my $result=&scantron_form_start($max_bubble).$default_form_data;      my $result=&scantron_form_start($max_bubble).$default_form_data;
     if ($env{'form.scantron_lastbubblepoints'} ne '') {  
         $result .= '<input type="hidden" name="scantron_lastbubblepoints" value="'.$env{'form.scantron_lastbubblepoints'}.'" />';  
     }  
     $r->print($result);      $r->print($result);
           
     my @validate_phases=( 'sequence',      my @validate_phases=( 'sequence',
Line 6995  sub scantron_validate_ID { Line 6973  sub scantron_validate_ID {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
   
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array.      &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return(1,$currentphase);          return(1,$currentphase);
Line 7408  sub scantron_bubble_selector { Line 7386  sub scantron_bubble_selector {
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
   
     my $scmode=$$scan_config{'Qon'};      my $scmode=$$scan_config{'Qon'};
     if ($scmode eq 'number' || $scmode eq 'letter') {      if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }     
         if (($$scan_config{'BubblesPerRow'} =~ /^\d+$/) &&  
             ($$scan_config{'BubblesPerRow'} > 0)) {  
             $max=$$scan_config{'BubblesPerRow'};  
             if (($scmode eq 'number') && ($max > 10)) {  
                 $max = 10;  
             } elsif (($scmode eq 'letter') && $max > 26) {  
                 $max = 26;  
             }  
         } else {  
             $max = 10;  
         }  
     }  
   
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
     $r->print(&Apache::loncommon::start_data_table().      $r->print(&Apache::loncommon::start_data_table().
Line 7575  sub scantron_validate_CODE { Line 7541  sub scantron_validate_CODE {
     my %allcodes=&get_codes();      my %allcodes=&get_codes();
   
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array.      &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return(1,$currentphase);          return(1,$currentphase);
Line 7634  sub scantron_validate_doublebubble { Line 7600  sub scantron_validate_doublebubble {
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.      &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return(1,$currentphase);          return(1,$currentphase);
Line 7656  sub scantron_validate_doublebubble { Line 7622  sub scantron_validate_doublebubble {
   
   
 sub scantron_get_maxbubble {  sub scantron_get_maxbubble {
     my ($nav_error,$scantron_config) = @_;      my ($nav_error) = @_;
     if (defined($env{'form.scantron_maxbubble'}) &&      if (defined($env{'form.scantron_maxbubble'}) &&
  $env{'form.scantron_maxbubble'}) {   $env{'form.scantron_maxbubble'}) {
  &restore_bubble_lines();   &restore_bubble_lines();
Line 7675  sub scantron_get_maxbubble { Line 7641  sub scantron_get_maxbubble {
     }      }
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     my $bubbles_per_row = &bubblesheet_bubbles_per_row($scantron_config);  
   
     &Apache::lonxml::clear_problem_counter();      &Apache::lonxml::clear_problem_counter();
   
Line 7691  sub scantron_get_maxbubble { Line 7656  sub scantron_get_maxbubble {
     my $response_number = 0;      my $response_number = 0;
     my $bubble_line     = 0;      my $bubble_line     = 0;
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
         my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,          my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
                                                           $udom,$bubbles_per_row);  
         if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {          if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
     foreach my $part_id (@{$parts}) {      foreach my $part_id (@{$parts}) {
                 my $lines;                  my $lines;
Line 7721  sub scantron_get_maxbubble { Line 7685  sub scantron_get_maxbubble {
                     if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {                      if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
                         $numshown = scalar(@{$analysis->{$part_id.'.shown'}});                          $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
                     }                      }
                     my $bubbles_per_row =                      my $bubbles_per_line = 10;
                         &bubblesheet_bubbles_per_row($scantron_config);                      my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                     my $inner_bubble_lines = int($numbub/$bubbles_per_row);                      if (($numbub % $bubbles_per_line) != 0) {
                     if (($numbub % $bubbles_per_row) != 0) {  
                         $inner_bubble_lines++;                          $inner_bubble_lines++;
                     }                      }
                     for (my $i=0; $i<$numshown; $i++) {                      for (my $i=0; $i<$numshown; $i++) {
Line 7735  sub scantron_get_maxbubble { Line 7698  sub scantron_get_maxbubble {
                     $lines = $numshown * $inner_bubble_lines;                      $lines = $numshown * $inner_bubble_lines;
                 } else {                  } else {
                     $lines = $analysis->{"$part_id.bubble_lines"};                      $lines = $analysis->{"$part_id.bubble_lines"};
                 }                  } 
   
                 $first_bubble_line{$response_number} = $bubble_line;                  $first_bubble_line{$response_number} = $bubble_line;
         $bubble_lines_per_response{$response_number} = $lines;          $bubble_lines_per_response{$response_number} = $lines;
Line 7756  sub scantron_get_maxbubble { Line 7719  sub scantron_get_maxbubble {
     return $env{'form.scantron_maxbubble'};      return $env{'form.scantron_maxbubble'};
 }  }
   
 sub bubblesheet_bubbles_per_row {  
     my ($scantron_config) = @_;  
     my $bubbles_per_row;  
     if (ref($scantron_config) eq 'HASH') {  
         $bubbles_per_row = $scantron_config->{'BubblesPerRow'};  
     }  
     if ((!$bubbles_per_row) || ($bubbles_per_row < 1)) {  
         $bubbles_per_row = 10;  
     }  
     return $bubbles_per_row;  
 }  
   
 sub scantron_validate_missingbubbles {  sub scantron_validate_missingbubbles {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #get student info      #get student info
Line 7778  sub scantron_validate_missingbubbles { Line 7729  sub scantron_validate_missingbubbles {
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $nav_error;      my $nav_error;
     my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);      my $max_bubble=&scantron_get_maxbubble(\$nav_error);
     if ($nav_error) {      if ($nav_error) {
         return(1,$currentphase);          return(1,$currentphase);
     }      }
Line 7825  sub scantron_validate_missingbubbles { Line 7776  sub scantron_validate_missingbubbles {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 sub hand_bubble_option {  
     my (undef, undef, $sequence) =  
         &Apache::lonnet::decode_symb($env{'form.selectpage'});  
     return if ($sequence eq '');  
     my $navmap = Apache::lonnavmaps::navmap->new();  
     unless (ref($navmap)) {  
         return;  
     }  
     my $needs_hand_bubbles;  
     my $map=$navmap->getResourceByUrl($sequence);  
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);  
     foreach my $res (@resources) {  
         if (ref($res)) {  
             if ($res->is_problem()) {  
                 my $partlist = $res->parts();  
                 foreach my $part (@{ $partlist }) {  
                     my @types = $res->responseType($part);  
                     if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) {  
                         $needs_hand_bubbles = 1;  
                         last;  
                     }  
                 }  
             }  
         }  
     }  
     if ($needs_hand_bubbles) {  
         my %scantron_config=&get_scantron_config($env{'form.scantron_format'});  
         my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);  
         return &mt('The sequence to be graded contains response types which are handgraded.').'<p>'.  
                &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','<br />').  
                '<label><input type="radio" name="scantron_lastbubblepoints" value="'.$bubbles_per_row.'" checked="checked" />'.&mt('[quant,_1,point]',$bubbles_per_row).'</label>&nbsp;'.&mt('or').'&nbsp;'.  
                '<label><input type="radio" name="scantron_lastbubblepoints" value="0"/>0 points</label></p>';  
     }  
     return;  
 }  
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
Line 7896  sub scantron_process_students { Line 7812  sub scantron_process_students {
         }          }
         my ($analysis,$parts) =          my ($analysis,$parts) =
             &scantron_partids_tograde($resource,$env{'request.course.id'},              &scantron_partids_tograde($resource,$env{'request.course.id'},
                                       $env{'user.name'},$env{'user.domain'},                                        $env{'user.name'},$env{'user.domain'},1);
                                       1,$bubbles_per_row);  
         $grader_partids_by_symb{$ressymb} = $parts;          $grader_partids_by_symb{$ressymb} = $parts;
         if (ref($analysis) eq 'HASH') {          if (ref($analysis) eq 'HASH') {
             if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {              if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
Line 7935  SCANTRONFORM Line 7850  SCANTRONFORM
     my $started;      my $started;
   
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.      &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
Line 7992  SCANTRONFORM Line 7907  SCANTRONFORM
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 my ($analysis,$parts) =                  my ($analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},                      &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
                                               $uname,$udom,undef,$bubbles_per_row);  
                 $partids_by_symb{$ressymb} = $parts;                  $partids_by_symb{$ressymb} = $parts;
             } else {              } else {
                 $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};                  $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
Line 8022  SCANTRONFORM Line 7936  SCANTRONFORM
         }          }
   
         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,          if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                    \@resources,\%partids_by_symb,                                     \@resources,\%partids_by_symb) eq 'ssi_error') {
                                    $bubbles_per_row) eq 'ssi_error') {  
             $ssi_error = 0; # So end of handler error message does not trigger.              $ssi_error = 0; # So end of handler error message does not trigger.
             $r->print("</form>");              $r->print("</form>");
             &ssi_print_error($r);              &ssi_print_error($r);
Line 8051  SCANTRONFORM Line 7964  SCANTRONFORM
             if ($studentrecord ne $studentdata) {              if ($studentrecord ne $studentdata) {
                 &Apache::lonxml::clear_problem_counter();                  &Apache::lonxml::clear_problem_counter();
                 if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,                  if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                            \@resources,\%partids_by_symb,                                             \@resources,\%partids_by_symb) eq 'ssi_error') {
                                            $bubbles_per_row) eq 'ssi_error') {  
                     $ssi_error = 0; # So end of handler error message does not trigger.                      $ssi_error = 0; # So end of handler error message does not trigger.
                     $r->print("</form>");                      $r->print("</form>");
                     &ssi_print_error($r);                      &ssi_print_error($r);
Line 8124  sub graders_resources_pass { Line 8036  sub graders_resources_pass {
             my $ressymb = $resource->symb();              my $ressymb = $resource->symb();
             my ($analysis,$parts) =              my ($analysis,$parts) =
                 &scantron_partids_tograde($resource,$env{'request.course.id'},                  &scantron_partids_tograde($resource,$env{'request.course.id'},
                                           $env{'user.name'},$env{'user.domain'},                                            $env{'user.name'},$env{'user.domain'},1);
                                           1,$bubbles_per_row);  
             $grader_partids_by_symb->{$ressymb} = $parts;              $grader_partids_by_symb->{$ressymb} = $parts;
             if (ref($analysis) eq 'HASH') {              if (ref($analysis) eq 'HASH') {
                 if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {                  if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
Line 8139  sub graders_resources_pass { Line 8050  sub graders_resources_pass {
 }  }
   
 sub grade_student_bubbles {  sub grade_student_bubbles {
     my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;      my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_;
     if (ref($resources) eq 'ARRAY') {      if (ref($resources) eq 'ARRAY') {
         my $count = 0;          my $count = 0;
         foreach my $resource (@{$resources}) {          foreach my $resource (@{$resources}) {
Line 8152  sub grade_student_bubbles { Line 8063  sub grade_student_bubbles {
                         'grade_symb'     => $ressymb,                          'grade_symb'     => $ressymb,
                         'CODE'           => $scancode                          'CODE'           => $scancode
                        );                         );
             if ($bubbles_per_row ne '') {  
                 $form{'bubbles_per_row'} = $bubbles_per_row;  
             }  
             if ($env{'form.scantron_lastbubblepoints'} ne '') {  
                 $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'};  
             }  
             if (ref($parts) eq 'HASH') {              if (ref($parts) eq 'HASH') {
                 if (ref($parts->{$ressymb}) eq 'ARRAY') {                  if (ref($parts->{$ressymb}) eq 'ARRAY') {
                     foreach my $part (@{$parts->{$ressymb}}) {                      foreach my $part (@{$parts->{$ressymb}}) {
Line 8468  sub checkscantron_results { Line 8373  sub checkscantron_results {
                                     'inline',undef,'checkscantron');                                      'inline',undef,'checkscantron');
     my ($username,$domain,$started);      my ($username,$domain,$started);
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.      &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
     if ($nav_error) {      if ($nav_error) {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
Line 8518  sub checkscantron_results { Line 8423  sub checkscantron_results {
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 (my $analysis,$parts) =                  (my $analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},                      &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain);
                                               $username,$domain,undef,  
                                               $bubbles_per_row);  
             } else {              } else {
                 $parts = $grader_partids_by_symb{$ressymb};                  $parts = $grader_partids_by_symb{$ressymb};
             }              }
Line 9066  sub init_perm { Line 8969  sub init_perm {
     }      }
 }  }
   
   sub init_old_essays {
       my ($symb,$apath,$adom,$aname) = @_;
       if ($symb ne '') {
           my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
           if (keys(%essays) > 0) {
               $old_essays{$symb} = \%essays;
           }
       }
       return;
   }
   
   sub reset_old_essays {
       undef(%old_essays);
   }
   
 sub gather_clicker_ids {  sub gather_clicker_ids {
     my %clicker_ids;      my %clicker_ids;
   
Line 9167  sub process_clicker { Line 9085  sub process_clicker {
     my $pincorrect=&mt("Percentage points for incorrect solution");      my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',      my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
                                                    {'iclicker' => 'i>clicker',                                                     {'iclicker' => 'i>clicker',
                                                     'interwrite' => 'interwrite PRS',                                                      'interwrite' => 'interwrite PRS'});
                                                     'turning' => 'Turning Technologies'});  
     $symb = &Apache::lonenc::check_encrypt($symb);      $symb = &Apache::lonenc::check_encrypt($symb);
     $result.=<<ENDUPFORM;      $result.=<<ENDUPFORM;
 <script type="text/javascript">  <script type="text/javascript">
Line 9341  ENDHEADER Line 9258  ENDHEADER
     if ($env{'form.upfiletype'} eq 'interwrite') {      if ($env{'form.upfiletype'} eq 'interwrite') {
         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);          ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
     }      }
     if ($env{'form.upfiletype'} eq 'turning') {  
         ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);  
     }  
     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.      $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
              '<input type="hidden" name="number" value="'.$number.'" />'.               '<input type="hidden" name="number" value="'.$number.'" />'.
              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',               &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
Line 9475  sub interwrite_eval { Line 9389  sub interwrite_eval {
     return ($errormsg,$number);      return ($errormsg,$number);
 }  }
   
 sub turning_eval {  
     my ($questiontitles,$responses)=@_;  
     my $number=0;  
     my $errormsg='';  
     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {  
         my %components=&Apache::loncommon::record_sep($line);  
         my @entries=map {$components{$_}} (sort(keys(%components)));  
         if ($#entries>$number) { $number=$#entries; }  
         my $id=$entries[0];  
         my @idresponses;  
         $id=~s/^[\#0]+//;  
         unless ($id) { next; }  
         for (my $idx=1;$idx<=$#entries;$idx++) {  
             $entries[$idx]=~s/\,/\;/g;  
             $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g;  
             push(@idresponses,$entries[$idx]);  
         }  
         $$responses{$id}=join(',',@idresponses);  
     }  
     for (my $i=1; $i<=$number; $i++) {  
         $$questiontitles[$i]=&mt('Question [_1]',$i);  
     }  
     return ($errormsg,$number);  
 }  
   
 sub assign_clicker_grades {  sub assign_clicker_grades {
     my ($r)=@_;      my ($r)=@_;
     my ($symb)=&get_symb($r);      my ($symb)=&get_symb($r);
Line 9897  ssi_with_retries() Line 9786  ssi_with_retries()
        calling routine should trap the error condition and display the warning         calling routine should trap the error condition and display the warning
        found in &navmap_errormsg().         found in &navmap_errormsg().
   
        $scantron_config - Reference to bubblesheet format configuration hash.  
   
    Returns the maximum number of bubble lines that are expected to     Returns the maximum number of bubble lines that are expected to
    occur. Does this by walking the selected sequence rendering the     occur. Does this by walking the selected sequence rendering the
    resource and then checking &Apache::lonxml::get_problem_counter()     resource and then checking &Apache::lonxml::get_problem_counter()
Removed from v.1.596.2.12.2.4  
changed lines
  Added in v.1.596.2.13

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