[LON-CAPA-cvs] cvs: loncom /homework grades.pm

raeburn lon-capa-cvs-allow@mail.lon-capa.org
Mon, 21 Apr 2008 16:30:49 -0000


raeburn		Mon Apr 21 12:30:49 2008 EDT

  Modified files:              
    /loncom/homework	grades.pm 
  Log:
  Bug 5650. scantronformat.tab file defined in configuration.db for domain
  - &get_scantronformat_file() added to retrieve scantron format file  
     - when scantron grading in a course, scantronformat file selected in following order:
     1. custom.tab from RES space for domain of course.
     2. if no 1 - default.tab from RES space for domain of course
     3. if no 1 or 2 - /home/httpd/lonTabs/scantronformat.tab from local server
  
  
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.517 loncom/homework/grades.pm:1.518
--- loncom/homework/grades.pm:1.517	Wed Apr 16 19:30:03 2008
+++ loncom/homework/grades.pm	Mon Apr 21 12:30:47 2008
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.517 2008/04/16 23:30:03 raeburn Exp $
+# $Id: grades.pm,v 1.518 2008/04/21 16:30:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4880,19 +4880,69 @@
 =cut
 
 sub scantron_scantab {
-    my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
     my $result='<select name="scantron_format">'."\n";
     $result.='<option></option>'."\n";
-    foreach my $line (<$fh>) {
-	my ($name,$descrip)=split(/:/,$line);
-	if ($name =~ /^\#/) { next; }
-	$result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
+    my @lines = &get_scantronformat_file();
+    if (@lines > 0) {
+        foreach my $line (@lines) {
+            next if (($line =~ /^\#/) || ($line eq ''));
+	    my ($name,$descrip)=split(/:/,$line);
+	    $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
+        }
     }
     $result.='</select>'."\n";
-
     return $result;
 }
 
+=pod
+
+=item get_scantronformat_file
+
+  Returns an array containing lines from the scantron format file for
+  the domain of the course.
+
+  If a url for a custom.tab file is listed in domain's configuration.db, 
+  lines are from this file.
+
+  Otherwise, if a default.tab has been published in RES space by the 
+  domainconfig user, lines are from this file.
+
+  Otherwise, fall back to getting lines from the legacy file on the
+  local server:  /home/httpd/lonTabs/scantronformat.tab    
+
+=cut
+
+sub get_scantronformat_file {
+    my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
+    my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
+    my $gottab = 0;
+    my @lines;
+    if (ref($domconfig{'scantron'}) eq 'HASH') {
+        if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+            my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
+            if ($formatfile ne '-1') {
+                @lines = split("\n",$formatfile,-1);
+                $gottab = 1;
+            }
+        }
+    }
+    if (!$gottab) {
+        my $confname = $cdom.'-domainconfig';
+        my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
+        my $formatfile =  &Apache::lonnet::getfile($default);
+        if ($formatfile ne '-1') {
+            @lines = split("\n",$formatfile,-1);
+            $gottab = 1;
+        }
+    }
+    if (!$gottab) {
+        my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+        @lines = <$fh>;
+        close($fh);
+    }
+    return @lines;
+}
+
 =pod 
 
 =item scantron_CODElist
@@ -5151,10 +5201,10 @@
 
 sub get_scantron_config {
     my ($which) = @_;
-    my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+    my @lines = &get_scantronformat_file();
     my %config;
     #FIXME probably should move to XML it has already gotten a bit much now
-    foreach my $line (<$fh>) {
+    foreach my $line (@lines) {
 	my ($name,$descrip)=split(/:/,$line);
 	if ($name ne $which ) { next; }
 	chomp($line);