--- loncom/homework/grades.pm	2008/03/24 19:14:07	1.513.2.2
+++ loncom/homework/grades.pm	2008/05/23 22:14:25	1.521
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.513.2.2 2008/03/24 19:14:07 raeburn Exp $
+# $Id: grades.pm,v 1.521 2008/05/23 22:14:25 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -89,7 +89,7 @@ my $ssi_error_message;
 #   On success, returns the rendered resource identified by the resource parameter.
 # Side Effects:
 #   The following global variables can be set:
-#    ssi_error           - If an unrecoverable error occurred this becomes true.
+#    ssi_error                - If an unrecoverable error occurred this becomes true.
 #                               It is up to the caller to initialize this to false
 #                               if desired.
 #    ssi_error_resource  - If an unrecoverable error occurred, this is the value
@@ -289,7 +289,7 @@ sub reset_caches {
 					    'grade_domain' => $udom,
 					    'grade_symb' => $symb,
 					    'grade_courseid' => 
-					     $env{'request.course.id'},
+					    $env{'request.course.id'},
 					    'grade_username' => $uname));
 	(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
 	my %analyze=&Apache::lonnet::str2hash($subresult);
@@ -1842,9 +1842,9 @@ sub download_all_link {
 	join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
 
     my $identifier = &Apache::loncommon::get_cgi_id();
-    &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students,
-                            'cgi.'.$identifier.'.symb' => $symb,
-                            'cgi.'.$identifier.'.parts' => $parts,);
+    &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students,
+                             'cgi.'.$identifier.'.symb' => $symb,
+                             'cgi.'.$identifier.'.parts' => $parts,});
     $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
 	      &mt('Download All Submitted Documents').'</a>');
     return
@@ -2768,7 +2768,7 @@ sub check_and_remove_from_queue {
 
 sub handback_files {
     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
-    my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
+    my $portfolio_root = '/userfiles/portfolio';
     my ($partlist,$handgrade,$responseType) = &response_type($symb);
 
     my @part_response_id = &flatten_responseType($responseType);
@@ -2786,7 +2786,8 @@ sub handback_files {
                     my ($answer_name,$answer_ver,$answer_ext) =
 		        &file_name_version_ext($answer_file);
 		    my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
-		    my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);
+                    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);
                     # fix file name
                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
@@ -2922,8 +2923,7 @@ sub version_portfiles {
     my $version_parts = join('|',@$v_flag);
     my @returned_keys;
     my $parts = join('|', @$parts_graded);
-    my $portfolio_root = &propath($domain,$stu_name).
-	'/userfiles/portfolio';
+    my $portfolio_root = '/userfiles/portfolio';
     foreach my $key (keys(%$record)) {
         my $new_portfiles;
         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
@@ -2934,7 +2934,8 @@ sub version_portfiles {
                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
 		my ($answer_name,$answer_ver,$answer_ext) =
 		    &file_name_version_ext($answer_file);
-                my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);
+                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 $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                 if ($new_answer ne 'problem getting file') {
@@ -4834,8 +4835,9 @@ sub get_response_bubbles {
 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,
-				    &propath($cdom,$cname));
+                                       $getpropath);
     my @possiblenames;
     foreach my $filename (sort(@files)) {
 	($filename)=split(/&/,$filename);
@@ -4878,19 +4880,76 @@ sub scantron_uploads {
 =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/default_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 @domains = &Apache::lonnet::current_machine_domains();
+        if (grep(/^\Q$cdom\E$/,@domains)) {
+            my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+            @lines = <$fh>;
+            close($fh);
+        } else {
+            my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
+            @lines = <$fh>;
+            close($fh);
+        }
+    }
+    return @lines;
+}
+
 =pod 
 
 =item scantron_CODElist
@@ -5149,10 +5208,10 @@ sub scantron_selectphase {
 
 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);
@@ -7460,6 +7519,7 @@ SCANTRONFORM
     my @delayqueue;
     my %completedstudents;
     
+    my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
     my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
  				    'Scantron Progress',$count,
@@ -7480,6 +7540,7 @@ SCANTRONFORM
 	$r->print("</form>");
 	&ssi_print_error($r);
 	$r->print(&show_grading_menu_form($symb));
+        &Apache::lonnet::remove_lock($lock);
 	return '';		# Dunno why the other returns return '' rather than just returning.
     }
 
@@ -7509,7 +7570,7 @@ SCANTRONFORM
   	($uname,$udom)=split(/:/,$uname);
 
 	&Apache::lonxml::clear_problem_counter();
-  	&Apache::lonnet::appenv(%$scan_record);
+  	&Apache::lonnet::appenv($scan_record);
 
 	if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
 	    &scantron_putfile($scanlines,$scan_data);
@@ -7537,6 +7598,7 @@ SCANTRONFORM
 		$r->print("</form>");
 		&ssi_print_error($r);
 		$r->print(&show_grading_menu_form($symb));
+                &Apache::lonnet::remove_lock($lock);
 		return '';	# Why return ''?  Beats me.
 	    }
 
@@ -7549,6 +7611,7 @@ SCANTRONFORM
 	&Apache::lonnet::delenv('scantron\.');
     }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+    &Apache::lonnet::remove_lock($lock);
 #    my $lasttime = &Time::HiRes::time()-$start;
 #    $r->print("<p>took $lasttime</p>");
 
@@ -8163,7 +8226,7 @@ sub process_clicker {
     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
 
     my %checked;
-    foreach my $gradingmechanism ('attendance','personnel','specific') {
+    foreach my $gradingmechanism ('attendance','personnel','specific','given') {
        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
           $checked{$gradingmechanism}="checked='checked'";
        }
@@ -8174,6 +8237,8 @@ sub process_clicker {
     my $attendance=&mt("Award points just for participation");
     my $personnel=&mt("Correctness determined from response by course personnel");
     my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
+    my $given=&mt("Correctness determined from given list of answers").' '.
+              '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>';
     my $pcorrect=&mt("Percentage points for correct solution");
     my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
@@ -8231,6 +8296,9 @@ function sanitycheck() {
 <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>
 <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>
 <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
+<br /><label><input type="radio" name="gradingmechanism" value="given" $checked{'given'} onClick="sanitycheck()" />$given </label>
+<br />&nbsp;&nbsp;&nbsp;
+<input type="text" name="givenanswer" size="50" />
 <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
 <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
 <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
@@ -8257,6 +8325,16 @@ sub process_clicker_file {
 	$result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
 	return $result.&show_grading_menu_form($symb);
     }
+    if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\w/)) {
+        $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>';
+        return $result.&show_grading_menu_form($symb);
+    }
+    if ($env{'form.gradingmechanism'} eq 'given') {
+        $env{'form.givenanswer'}=~s/^\s*//gs;
+        $env{'form.givenanswer'}=~s/\s*$//gs;
+        $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g;
+        $env{'form.givenanswer'}=uc($env{'form.givenanswer'});
+    }
     my %clicker_ids=&gather_clicker_ids();
     my %correct_ids;
     if ($env{'form.gradingmechanism'} eq 'personnel') {
@@ -8275,6 +8353,8 @@ sub process_clicker_file {
     }
     if ($env{'form.gradingmechanism'} eq 'attendance') {
 	$result.=&mt('Score based on attendance only');
+    } elsif ($env{'form.gradingmechanism'} eq 'given') {
+        $result.=&mt('Score based on [_1]','<tt>'.$env{'form.givenanswer'}.'</tt>');
     } else {
 	my $number=0;
 	$result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
@@ -8317,6 +8397,7 @@ sub process_clicker_file {
 <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
 <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
 <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
+<input type="hidden" name="givenanswer" value="$env{'form.givenanswer'}" />
 <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
 <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
 ENDHEADER
@@ -8378,7 +8459,7 @@ ENDHEADER
     }
     $result.='<hr />'.
              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
-    if ($env{'form.gradingmechanism'} ne 'attendance') {
+    if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
        if ($correct_count==0) {
           $errormsg.="Found no correct answers answers for grading!";
        } elsif ($correct_count>1) {