--- loncom/homework/grades.pm	2011/12/01 00:36:59	1.596.2.12
+++ loncom/homework/grades.pm	2012/05/02 14:23:34	1.596.2.12.2.2
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.596.2.12 2011/12/01 00:36:59 raeburn Exp $
+# $Id: grades.pm,v 1.596.2.12.2.2 2012/05/02 14:23:34 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -272,7 +272,7 @@ sub reset_caches {
     }
 
     sub get_analyze {
-	my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed)=@_;
+	my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_;
 	my $key = "$symb\0$uname\0$udom";
         if ($type eq 'randomizetry') {
             if ($trial ne '') {
@@ -306,6 +306,9 @@ sub reset_caches {
                     'grade_courseid'    =>  $env{'request.course.id'},
                     'grade_username'    => $uname,
                     'grade_noincrement' => $no_increment);
+        if ($bubbles_per_row ne '') {
+            $form{'bubbles_per_row'} = $bubbles_per_row;
+        }
         if ($type eq 'randomizetry') {
             $form{'grade_questiontype'} = $type;
             if ($rndseed ne '') {
@@ -346,7 +349,7 @@ sub reset_caches {
     }
 
     sub scantron_partids_tograde {
-        my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_;
+        my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_;
         my (%analysis,@parts);
         if (ref($resource)) {
             my $symb = $resource->symb();
@@ -354,7 +357,9 @@ sub reset_caches {
             if ($check_for_randomlist) {
                 $add_to_form = { 'check_parts_withrandomlist' => 1,};
             }
-            my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form);
+            my $analyze =
+                &get_analyze($symb,$uname,$udom,undef,$add_to_form,
+                             undef,undef,undef,$bubbles_per_row);
             if (ref($analyze) eq 'HASH') {
                 %analysis = %{$analyze};
             }
@@ -1825,7 +1830,6 @@ sub gradeBox {
     $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 .= 
 	    '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';
     $result.=&Apache::loncommon::end_data_table_row();
@@ -3002,8 +3006,10 @@ sub handback_files {
 		        &file_name_version_ext($answer_file);
 		    my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
                     my $getpropath = 1;
-		    my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
-		    my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
+                    my ($dir_list,$listerror) =
+                        &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,
+                                                 $domain,$stuname,$getpropath);
+		    my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
                     # fix file name
                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
@@ -3163,9 +3169,11 @@ sub version_portfiles {
                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
 		my ($answer_name,$answer_ver,$answer_ext) =
 		    &file_name_version_ext($answer_file);
-                my $getpropath = 1;    
-                my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
-                my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
+                my $getpropath = 1;
+                my ($dir_list,$listerror) =
+                    &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,
+                                             $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);
                 if ($new_answer ne 'problem getting file') {
                     push(@versioned_portfiles, $directory.$new_answer);
@@ -3184,21 +3192,24 @@ sub version_portfiles {
 sub get_next_version {
     my ($answer_name, $answer_ext, $dir_list) = @_;
     my $version;
-    foreach my $row (@$dir_list) {
-        my ($file) = split(/\&/,$row,2);
-        my ($file_name,$file_version,$file_ext) =
-	    &file_name_version_ext($file);
-        if (($file_name eq $answer_name) && 
-	    ($file_ext eq $answer_ext)) {
-                # gets here if filename and extension match, regardless of version
+    if (ref($dir_list) eq 'ARRAY') {
+        foreach my $row (@{$dir_list}) {
+            my ($file) = split(/\&/,$row,2);
+            my ($file_name,$file_version,$file_ext) =
+	        &file_name_version_ext($file);
+            if (($file_name eq $answer_name) && 
+	        ($file_ext eq $answer_ext)) {
+                # gets here if filename and extension match, 
+                # regardless of version
                 if ($file_version ne '') {
-                # a versioned file is found  so save it for later
-                if ($file_version > $version) {
-		    $version = $file_version;
+                    # a versioned file is found  so save it for later
+                    if ($file_version > $version) {
+		        $version = $file_version;
+                    }
 	        }
             }
         }
-    } 
+    }
     $version ++;
     return($version);
 }
@@ -5157,14 +5168,16 @@ sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
     my $getpropath = 1;
-    my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
-                                       $getpropath);
+    my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom,
+                                                        $cname,$getpropath);
     my @possiblenames;
-    foreach my $filename (sort(@files)) {
-	($filename)=split(/&/,$filename);
-	if ($filename!~/^scantron_orig_/) { next ; }
-	$filename=~s/^scantron_orig_//;
-	push(@possiblenames,$filename);
+    if (ref($dirlist) eq 'ARRAY') {
+        foreach my $filename (sort(@{$dirlist})) {
+	    ($filename)=split(/&/,$filename);
+	    if ($filename!~/^scantron_orig_/) { next ; }
+	    $filename=~s/^scantron_orig_//;
+	    push(@possiblenames,$filename);
+        }
     }
     return @possiblenames;
 }
@@ -5562,6 +5575,8 @@ sub scantron_selectphase {
  
       LastName    - column that the last name starts in
       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
 
@@ -5592,6 +5607,7 @@ sub get_scantron_config {
 	$config{'FirstNamelength'}=$config[14];
 	$config{'LastName'}=$config[15];
 	$config{'LastNamelength'}=$config[16];
+        $config{'BubblesPerRow'}=$config[17];
 	last;
     }
     return %config;
@@ -6515,7 +6531,8 @@ sub scantron_validate_file {
     #get the student pick code ready
     $r->print(&Apache::loncommon::studentbrowser_javascript());
     my $nav_error;
-    my $max_bubble=&scantron_get_maxbubble(\$nav_error);
+    my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+    my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return '';
@@ -6968,7 +6985,7 @@ sub scantron_validate_ID {
     my ($scanlines,$scan_data)=&scantron_getfile();
 
     my $nav_error;
-    &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array.
+    &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array.
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return(1,$currentphase);
@@ -7381,7 +7398,19 @@ sub scantron_bubble_selector {
     my $max=$$scan_config{'Qlength'};
 
     my $scmode=$$scan_config{'Qon'};
-    if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }	     
+    if ($scmode eq 'number' || $scmode eq 'letter') {
+        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');
     $r->print(&Apache::loncommon::start_data_table().
@@ -7536,7 +7565,7 @@ sub scantron_validate_CODE {
     my %allcodes=&get_codes();
 
     my $nav_error;
-    &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array.
+    &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array.
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return(1,$currentphase);
@@ -7595,7 +7624,7 @@ sub scantron_validate_doublebubble {
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();
     my $nav_error;
-    &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array.
+    &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return(1,$currentphase);
@@ -7617,7 +7646,7 @@ sub scantron_validate_doublebubble {
 
 
 sub scantron_get_maxbubble {
-    my ($nav_error) = @_;
+    my ($nav_error,$scantron_config) = @_;
     if (defined($env{'form.scantron_maxbubble'}) &&
 	$env{'form.scantron_maxbubble'}) {
 	&restore_bubble_lines();
@@ -7636,6 +7665,7 @@ sub scantron_get_maxbubble {
     }
     my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
+    my $bubbles_per_row = &bubblesheet_bubbles_per_row($scantron_config);
 
     &Apache::lonxml::clear_problem_counter();
 
@@ -7651,7 +7681,8 @@ sub scantron_get_maxbubble {
     my $response_number = 0;
     my $bubble_line     = 0;
     foreach my $resource (@resources) {
-        my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
+        my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,
+                                                          $udom,$bubbles_per_row);
         if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
 	    foreach my $part_id (@{$parts}) {
                 my $lines;
@@ -7680,9 +7711,10 @@ sub scantron_get_maxbubble {
                     if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
                         $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
                     }
-                    my $bubbles_per_line = 10;
-                    my $inner_bubble_lines = int($numbub/$bubbles_per_line);
-                    if (($numbub % $bubbles_per_line) != 0) {
+                    my $bubbles_per_row =
+                        &bubblesheet_bubbles_per_row($scantron_config);
+                    my $inner_bubble_lines = int($numbub/$bubbles_per_row);
+                    if (($numbub % $bubbles_per_row) != 0) {
                         $inner_bubble_lines++;
                     }
                     for (my $i=0; $i<$numshown; $i++) {
@@ -7693,7 +7725,7 @@ sub scantron_get_maxbubble {
                     $lines = $numshown * $inner_bubble_lines;
                 } else {
                     $lines = $analysis->{"$part_id.bubble_lines"};
-                } 
+                }
 
                 $first_bubble_line{$response_number} = $bubble_line;
 	        $bubble_lines_per_response{$response_number} = $lines;
@@ -7714,6 +7746,18 @@ sub scantron_get_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 {
     my ($r,$currentphase) = @_;
     #get student info
@@ -7724,7 +7768,7 @@ sub scantron_validate_missingbubbles {
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();
     my $nav_error;
-    my $max_bubble=&scantron_get_maxbubble(\$nav_error);
+    my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);
     if ($nav_error) {
         return(1,$currentphase);
     }
@@ -7807,7 +7851,8 @@ sub scantron_process_students {
         }
         my ($analysis,$parts) =
             &scantron_partids_tograde($resource,$env{'request.course.id'},
-                                      $env{'user.name'},$env{'user.domain'},1);
+                                      $env{'user.name'},$env{'user.domain'},
+                                      1,$bubbles_per_row);
         $grader_partids_by_symb{$ressymb} = $parts;
         if (ref($analysis) eq 'HASH') {
             if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
@@ -7845,7 +7890,7 @@ SCANTRONFORM
     my $started;
 
     my $nav_error;
-    &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
+    &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return '';
@@ -7902,7 +7947,8 @@ SCANTRONFORM
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 my ($analysis,$parts) =
-                    &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
+                    &scantron_partids_tograde($resource,$env{'request.course.id'},
+                                              $uname,$udom,undef,$bubbles_per_row);
                 $partids_by_symb{$ressymb} = $parts;
             } else {
                 $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
@@ -7931,7 +7977,8 @@ SCANTRONFORM
         }
 
         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
-                                   \@resources,\%partids_by_symb) eq 'ssi_error') {
+                                   \@resources,\%partids_by_symb,
+                                   $bubbles_per_row) eq 'ssi_error') {
             $ssi_error = 0; # So end of handler error message does not trigger.
             $r->print("</form>");
             &ssi_print_error($r);
@@ -7959,7 +8006,8 @@ SCANTRONFORM
             if ($studentrecord ne $studentdata) {
                 &Apache::lonxml::clear_problem_counter();
                 if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
-                                           \@resources,\%partids_by_symb) eq 'ssi_error') {
+                                           \@resources,\%partids_by_symb,
+                                           $bubbles_per_row) eq 'ssi_error') {
                     $ssi_error = 0; # So end of handler error message does not trigger.
                     $r->print("</form>");
                     &ssi_print_error($r);
@@ -8031,7 +8079,8 @@ sub graders_resources_pass {
             my $ressymb = $resource->symb();
             my ($analysis,$parts) =
                 &scantron_partids_tograde($resource,$env{'request.course.id'},
-                                          $env{'user.name'},$env{'user.domain'},1);
+                                          $env{'user.name'},$env{'user.domain'},
+                                          1,$bubbles_per_row);
             $grader_partids_by_symb->{$ressymb} = $parts;
             if (ref($analysis) eq 'HASH') {
                 if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
@@ -8045,7 +8094,7 @@ sub graders_resources_pass {
 }
 
 sub grade_student_bubbles {
-    my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_;
+    my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;
     if (ref($resources) eq 'ARRAY') {
         my $count = 0;
         foreach my $resource (@{$resources}) {
@@ -8058,6 +8107,9 @@ sub grade_student_bubbles {
                         'grade_symb'     => $ressymb,
                         'CODE'           => $scancode
                        );
+            if ($bubbles_per_row ne '') {
+                $form{'bubbles_per_row'} = $bubbles_per_row;
+            }
             if (ref($parts) eq 'HASH') {
                 if (ref($parts->{$ressymb}) eq 'ARRAY') {
                     foreach my $part (@{$parts->{$ressymb}}) {
@@ -8368,7 +8420,7 @@ sub checkscantron_results {
                                     'inline',undef,'checkscantron');
     my ($username,$domain,$started);
     my $nav_error;
-    &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
+    &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
     if ($nav_error) {
         $r->print(&navmap_errormsg());
         return '';
@@ -8418,7 +8470,9 @@ sub checkscantron_results {
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                 (my $analysis,$parts) =
-                    &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain);
+                    &scantron_partids_tograde($resource,$env{'request.course.id'},
+                                              $username,$domain,undef,
+                                              $bubbles_per_row);
             } else {
                 $parts = $grader_partids_by_symb{$ressymb};
             }
@@ -9766,6 +9820,8 @@ ssi_with_retries()
        calling routine should trap the error condition and display the warning
        found in &navmap_errormsg().
 
+       $scantron_config - Reference to bubblesheet format configuration hash.
+
    Returns the maximum number of bubble lines that are expected to
    occur. Does this by walking the selected sequence rendering the
    resource and then checking &Apache::lonxml::get_problem_counter()
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>