[LON-CAPA-cvs] cvs: loncom /homework default_homework.lcpm /homework/caparesponse caparesponse.pm

[raeburn]

raeburn		Mon Oct 18 19:47:39 2010 EDT

  Modified files:              
    /loncom/homework	default_homework.lcpm 
    /loncom/homework/caparesponse	caparesponse.pm 
  Log:
  - Bug 5531.
    - remove control characters from student submission for stringresponse, 
      unless "computer's answer" also includes control characters.
      (correctness evaluated with control characters removed). 
    - log to lonnet.log if control characters were removed (if <CR>, <FF> or
      newline, escape these control characters, when included in log report). 
  
  
Index: loncom/homework/default_homework.lcpm
diff -u loncom/homework/default_homework.lcpm:1.149 loncom/homework/default_homework.lcpm:1.150
--- loncom/homework/default_homework.lcpm:1.149	Thu Oct 14 19:54:56 2010
+++ loncom/homework/default_homework.lcpm	Mon Oct 18 19:47:31 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA 
 # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
 #
-# $Id: default_homework.lcpm,v 1.149 2010/10/14 19:54:56 raeburn Exp $
+# $Id: default_homework.lcpm,v 1.150 2010/10/18 19:47:31 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -357,6 +357,17 @@
 	}
     }
 
+    my $allow_control_char = 0;
+    my $control_chars_removed = 0;
+    if ($type eq 'cs' || $type eq 'ci') {
+        if (ref($LONCAPA::CAPAresponse_answer->{'answers'}) eq 'ARRAY') {
+            foreach my $strans (@{$LONCAPA::CAPAresponse_answer->{'answers'}}) {
+                if ($strans =~ /[\000-\037]/) {
+                    $allow_control_char = 1;
+                }
+            }
+        }
+    }
 
 #    &LONCAPA_INTERNAL_DEBUG(&LONCAPA_INTERNAL_Dumper($responses));
     my %memoized;
@@ -366,7 +377,15 @@
 	    my $response = $responses->[$i];
 	    my $key = "$answer\0$response";
 	    my (@awards,@msgs);
-	    for (my $j=0; $j<scalar(@$response); $j++) { 
+	    for (my $j=0; $j<scalar(@$response); $j++) {
+                if ($type eq 'cs' || $type eq 'ci') {
+                    unless ($allow_control_char) {
+                        if ($response->[$j] =~ /[\000-\037]/) { 
+                            $response->[$j] =~ s/[\000-\037]//g;
+                            $control_chars_removed = 1;
+                        }  
+                    }
+                }
 		my ($award,$msg) = &caparesponse_check($answer->[$j],
 						       $response->[$j]);
                 if ($type eq 'cs' || $type eq 'ci') {
@@ -397,6 +416,14 @@
 		} else {
 		    my (@awards,@msgs);
 		    for (my $j=0; $j<scalar(@$response); $j++) {
+                        if ($type eq 'cs' || $type eq 'ci') {
+                            unless ($allow_control_char) {
+                                if ($response->[$j] =~ /[\000-\037]/) {
+                                    $response->[$j] =~ s/[\000-\037]//g;
+                                    $control_chars_removed = 1;
+                                }
+                            }
+                        }
 			my ($award,$msg) = &caparesponse_check($answer->[$j],
 							       $response->[$j]);
                         if ($type eq 'cs' || $type eq 'ci') {
@@ -449,7 +476,7 @@
     &LONCAPA_INTERNAL_DEBUG(" all final_awards ".join(':',@final_awards));
     my ($final_award,$final_msg) = 
 	&LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1);
-    return ($final_award,$final_msg,$error);
+    return ($final_award,$final_msg,$error,$control_chars_removed);
 }
 
 sub verify_stringresponse {
Index: loncom/homework/caparesponse/caparesponse.pm
diff -u loncom/homework/caparesponse/caparesponse.pm:1.241 loncom/homework/caparesponse/caparesponse.pm:1.242
--- loncom/homework/caparesponse/caparesponse.pm:1.241	Thu Oct 14 19:55:04 2010
+++ loncom/homework/caparesponse/caparesponse.pm	Mon Oct 18 19:47:39 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # caparesponse definition
 #
-# $Id: caparesponse.pm,v 1.241 2010/10/14 19:55:04 raeburn Exp $
+# $Id: caparesponse.pm,v 1.242 2010/10/18 19:47:39 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1229,11 +1229,27 @@
 			${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});
 			my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);
                         if ($$args_ref{'type'} =~ /^c[si]$/) {
+                            my $control_chars_removed = pop(@msgs);
                             my $error = pop(@msgs);
-                            if ($error ne '') {
+                            if (($error ne '') || 
+                                ($control_chars_removed ne '')) {
                                 my ($symb,$courseid,$domain,$name) =
                                     &Apache::lonnet::whichuser();
-                                &Apache::lonnet::logthis("Stringresponse grading error: $error for $name:$domain in $courseid for part: $part response: $id and symb: $symb");
+                                if ($control_chars_removed ne '') {
+                                    my $showresponse = $response;
+                                    if ($response =~ /[\000-\037]/) {
+                                        $response =~ s/[\000-\037]//g;
+                                    }
+                                    if ($showresponse  =~ /[\r\n\f]/) {
+                                        my @lines = split(/[\r\n\f]+/,$showresponse);
+                                        $showresponse = join('\\n',@lines);
+                                    }
+                                    &Apache::lonnet::logthis("Stringresponse grading: control characters stripped from submission ".$showresponse." for $name:$domain in $courseid for part: $part response: $id and symb: $symb");
+                                    $Apache::lonhomework::results{"resource.$part.$id.submission"} = $response;
+                                }
+                                if ($error ne '') {
+                                    &Apache::lonnet::logthis("Stringresponse grading error: $error for $name:$domain in $courseid for part: $part response: $id and symb: $symb");
+                                }
                             }
                         }
 			&Apache::lonxml::debug('msgs are'.join(':',@msgs));