--- loncom/homework/grades.pm	2012/05/02 14:23:34	1.596.2.12.2.2
+++ loncom/homework/grades.pm	2012/05/02 15:28:09	1.596.2.12.2.4
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.596.2.12.2.2 2012/05/02 14:23:34 raeburn Exp $
+# $Id: grades.pm,v 1.596.2.12.2.4 2012/05/02 15:28:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6392,6 +6392,12 @@ sub scantron_warning_screen {
 	    '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
 	    $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 ('
 <p>
 <span class="LC_warning">
@@ -6400,7 +6406,7 @@ sub scantron_warning_screen {
 <table>
 <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>
-'.$CODElist.'
+'.$CODElist.$lastbubblepoints.'
 </table>
 <br />
 <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>
@@ -6440,8 +6446,9 @@ sub scantron_do_warning {
 	} 
     } else {
 	my $warning=&scantron_warning_screen('Grading: Validate Records');
+        my $bubbledbyhand=&hand_bubble_option();
 	$r->print('
-'.$warning.'
+'.$warning.$bubbledbyhand.'
 <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
 <input type="hidden" name="command" value="scantron_validate" />
 ');
@@ -6538,6 +6545,9 @@ sub scantron_validate_file {
         return '';
     }
     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);
     
     my @validate_phases=( 'sequence',
@@ -7815,6 +7825,41 @@ sub scantron_validate_missingbubbles {
     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 {
     my ($r) = @_;
@@ -8110,6 +8155,9 @@ sub grade_student_bubbles {
             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->{$ressymb}) eq 'ARRAY') {
                     foreach my $part (@{$parts->{$ressymb}}) {
@@ -9119,7 +9167,8 @@ sub process_clicker {
     my $pincorrect=&mt("Percentage points for incorrect solution");
     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
                                                    {'iclicker' => 'i>clicker',
-                                                    'interwrite' => 'interwrite PRS'});
+                                                    'interwrite' => 'interwrite PRS',
+                                                    'turning' => 'Turning Technologies'});
     $symb = &Apache::lonenc::check_encrypt($symb);
     $result.=<<ENDUPFORM;
 <script type="text/javascript">
@@ -9292,6 +9341,9 @@ ENDHEADER
     if ($env{'form.upfiletype'} eq 'interwrite') {
         ($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 />'.
              '<input type="hidden" name="number" value="'.$number.'" />'.
              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
@@ -9422,6 +9474,31 @@ sub interwrite_eval {
     }
     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 {
     my ($r)=@_;