[LON-CAPA-cvs] cvs: loncom /homework default_homework.lcpm response.pm /homework/caparesponse caparesponse.pm
raeburn
raeburn@source.lon-capa.org
Thu, 14 Oct 2010 19:55:04 -0000
This is a MIME encoded message
--raeburn1287086104
Content-Type: text/plain
raeburn Thu Oct 14 19:55:04 2010 EDT
Modified files:
/loncom/homework response.pm default_homework.lcpm
/loncom/homework/caparesponse caparesponse.pm
Log:
- Bug 5531.
- Detect where student resubmits previous answer for case sensitive
stringreponse item and award changes to EXACT_ANS.
Detect for case insensitive stringresponse when previous award changes
to EXACT_ANS for submissions whch only differ by case.
- logs to lonnet.log and sends e-mail to recipients of "errormail" for
course domain.
- For cs and ci types if award is INCORRECT use perl to compare
response with answer, and log if disagreement with result from
strcasecmp() or strcmp() to capa_check_answer() in capaCommon.
--raeburn1287086104
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20101014195504.txt"
Index: loncom/homework/response.pm
diff -u loncom/homework/response.pm:1.218 loncom/homework/response.pm:1.219
--- loncom/homework/response.pm:1.218 Sun Jun 20 12:42:44 2010
+++ loncom/homework/response.pm Thu Oct 14 19:54:56 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# various response type definitons response definition
#
-# $Id: response.pm,v 1.218 2010/06/20 12:42:44 raeburn Exp $
+# $Id: response.pm,v 1.219 2010/10/14 19:54:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -280,7 +280,7 @@
}
sub check_for_previous {
- my ($curresponse,$partid,$id,$last) = @_;
+ my ($curresponse,$partid,$id,$last,$type) = @_;
my %previous;
$previous{'used'} = 0;
foreach my $key (sort(keys(%Apache::lonhomework::history))) {
@@ -305,7 +305,15 @@
if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; }
if ($previous{'award'} eq 'INTERNAL_ERROR') { $previous{'used'}=0; }
&Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");
- }
+ } elsif ($type eq 'ci') {
+ if (lc($pastresponse) eq lc($curresponse)) {
+ if ($key =~ /^(\d+):/) {
+ push (@{$previous{'versionci'}},$1);
+ $previous{'awardci'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};
+ $previous{'usedci'} = 1;
+ }
+ }
+ }
}
}
&Apache::lonhomework::showhash(%previous);
Index: loncom/homework/default_homework.lcpm
diff -u loncom/homework/default_homework.lcpm:1.148 loncom/homework/default_homework.lcpm:1.149
--- loncom/homework/default_homework.lcpm:1.148 Thu Oct 14 04:59:08 2010
+++ loncom/homework/default_homework.lcpm Thu Oct 14 19:54:56 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.148 2010/10/14 04:59:08 raeburn Exp $
+# $Id: default_homework.lcpm,v 1.149 2010/10/14 19:54:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -320,6 +320,7 @@
}
&LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:");
$unit=~s/\s//;
+ my $error;
foreach my $response (@$responses) {
foreach my $element (@$response) {
if (($type eq 'float') || (($type eq '') && ($unit ne ''))) {
@@ -368,6 +369,10 @@
for (my $j=0; $j<scalar(@$response); $j++) {
my ($award,$msg) = &caparesponse_check($answer->[$j],
$response->[$j]);
+ if ($type eq 'cs' || $type eq 'ci') {
+ $error = &verify_stringresponse($type,$award,$response->[$j],
+ $answer->[$j]);
+ }
push(@awards,$award);
push(@msgs, $msg);
}
@@ -394,6 +399,10 @@
for (my $j=0; $j<scalar(@$response); $j++) {
my ($award,$msg) = &caparesponse_check($answer->[$j],
$response->[$j]);
+ if ($type eq 'cs' || $type eq 'ci') {
+ $error = &verify_stringresponse($type,$award,$response->[$j],
+ $answer->[$j]);
+ }
push(@awards,$award);
push(@msgs, $msg);
}
@@ -440,7 +449,29 @@
&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);
+ return ($final_award,$final_msg,$error);
+}
+
+sub verify_stringresponse {
+ my ($type,$award,$resp,$ans) = @_;
+ return if ($award eq 'EXACT_ANS');
+ my $error;
+ if ($resp =~ /^\s|\s$/) {
+ $resp =~ s{^\s+|\s+$}{}g;
+ }
+ if ($ans =~ /^\s|\s$/) {
+ $ans =~ s{^\s+|\s+$}{}g;
+ }
+ if ($type eq 'ci') {
+ $resp = lc($resp);
+ $ans = lc($ans);
+ }
+ if ($resp eq $ans) {
+ if ($award eq 'INCORRECT') {
+ $error = 'MISGRADED';
+ }
+ }
+ return $error;
}
sub cas {
Index: loncom/homework/caparesponse/caparesponse.pm
diff -u loncom/homework/caparesponse/caparesponse.pm:1.240 loncom/homework/caparesponse/caparesponse.pm:1.241
--- loncom/homework/caparesponse/caparesponse.pm:1.240 Thu Oct 14 04:02:07 2010
+++ loncom/homework/caparesponse/caparesponse.pm Thu Oct 14 19:55:04 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# caparesponse definition
#
-# $Id: caparesponse.pm,v 1.240 2010/10/14 04:02:07 raeburn Exp $
+# $Id: caparesponse.pm,v 1.241 2010/10/14 19:55:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,6 +33,7 @@
use Apache::lonmaxima();
use Apache::lonlocal;
use Apache::lonnet;
+use Apache::lonmsg();
use Apache::response();
use Storable qw(dclone);
@@ -465,6 +466,48 @@
return($ad,$msg, $name);
}
+sub stringresponse_gradechange {
+ my ($part,$id,$previous,$caller,$response,$ad,$type) = @_;
+ return unless (ref($previous) eq 'HASH');
+ my ($prevarray,$prevaward);
+ my %typenames = (
+ cs => 'Case sensitive',
+ ci => 'Case insensitive',
+ );
+ if ($caller eq 'cs') {
+ return unless (ref($previous->{'version'}) eq 'ARRAY');
+ $prevarray = $previous->{'version'};
+ $prevaward = $previous->{'award'};
+ } elsif ($caller eq 'ci') {
+ return unless (ref($previous->{'versionci'}) eq 'ARRAY');
+ $prevarray = $previous->{'versionci'};
+ $prevaward = $previous->{'awardci'};
+ } else {
+ return;
+ }
+ my $count=0;
+ my %count_lookup;
+ foreach my $i (1..$Apache::lonhomework::history{'version'}) {
+ my $prefix = $i.":resource.$part";
+ next if (!exists($Apache::lonhomework::history{"$prefix.award"}));
+ $count++;
+ $count_lookup{$i} = $count;
+ }
+ my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
+ my %coursedesc = &Apache::lonnet::coursedescription($courseid);
+ my $cdom = $coursedesc{'domain'};
+ my $versions = ' (submissions: '.join(', ',map {$count_lookup{$_} } @{$prevarray}).')';
+ my $warning = "String Response ($typenames{$type}) grading discrepancy: award for response of $response changed from $prevaward".$versions." to $ad; user: $name:$domain in course: $courseid for part: $part response: $id for symb: $symb";
+ &Apache::lonnet::logthis($warning);
+ my $origmail = $Apache::lonnet::perlvar{'lonAdmEMail'};
+ my $recipients = &Apache::loncommon::build_recipient_list(undef,'errormail',
+ $cdom,$origmail);
+ if ($recipients ne '') {
+ &Apache::lonmsg::sendemail($recipients,'Stringresponse Grading Discrepancy',$warning);
+ }
+ return;
+}
+
sub add_in_tag_answer {
my ($parstack,$safeeval,$response_level) = @_;
my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,
@@ -1153,7 +1196,8 @@
my $response = &Apache::response::getresponse();
if ( $response =~ /[^\s]/) {
my %previous = &Apache::response::check_for_previous($response,
- $part,$id);
+ $part,$id,
+ undef,$type);
&Apache::lonxml::debug("submitted a $response<br>\n");
&Apache::lonxml::debug($$parstack[-1] . "\n<br>");
$Apache::lonhomework::results{"resource.$part.$id.submission"}=
@@ -1184,6 +1228,14 @@
&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
${$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 $error = pop(@msgs);
+ if ($error 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");
+ }
+ }
&Apache::lonxml::debug('msgs are'.join(':',@msgs));
my ($awards)=split(/:/,$result);
my (@awards) = split(/,/,$awards);
@@ -1211,6 +1263,19 @@
$ad='ANONYMOUS_CREDIT';
}
}
+ unless ($env{'request.state'} eq 'construct') {
+ if ($previous{'used'}) {
+ if ($ad ne $previous{'award'} && $previous{'award'} ne '') {
+ &stringresponse_gradechange($part,$id,\%previous,
+ 'cs',$response,$ad,$type);
+ }
+ } elsif ($previous{'usedci'}) {
+ if ($ad ne $previous{'awardci'} && $previous{'awardci'} ne '') {
+ &stringresponse_gradechange($part,$id,\%previous,
+ 'ci',$response,$ad,$type);
+ }
+ }
+ }
&Apache::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=$msg;
--raeburn1287086104--