[LON-CAPA-cvs] cvs: modules /raeburn neutrinoharvest.pl
raeburn
raeburn@source.lon-capa.org
Mon, 18 Oct 2010 16:17:02 -0000
This is a MIME encoded message
--raeburn1287418622
Content-Type: text/plain
raeburn Mon Oct 18 16:17:02 2010 EDT
Modified files:
/modules/raeburn neutrinoharvest.pl
Log:
- Bug 5531.
- Efficiency: only loop over students if course contains stringresponse items.
- Summary output to screen after completion of checking, for each course.
--raeburn1287418622
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20101018161702.txt"
Index: modules/raeburn/neutrinoharvest.pl
diff -u modules/raeburn/neutrinoharvest.pl:1.5 modules/raeburn/neutrinoharvest.pl:1.6
--- modules/raeburn/neutrinoharvest.pl:1.5 Mon Oct 18 04:23:46 2010
+++ modules/raeburn/neutrinoharvest.pl Mon Oct 18 16:17:02 2010
@@ -78,7 +78,7 @@
} else {
my $errormsg = "Usage: neutrinoharvest.pl <Seconds since last access to filter courses|course_ids e.g., sfu_5H34111eaeeee4b95sful1 sfu_1J125875c1efa4b46sful1>\n";
- print $errormsg;
+ print STDOUT $errormsg;
print $fh $errormsg;
delete($env{'allowed.bre'});
print $fh "==== neutrinoharvest.pl completed ".localtime()." ====\n";
@@ -160,6 +160,7 @@
&Apache::lonuserstate::readmap($cdom.'/'.$cnum);
# check course contents
my %strings = &coursecontent_constraints($cnum,$cdom);
+ my $totalsymbs = scalar(keys(%strings));
my @okstudents;
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
if ($students ne '') {
@@ -168,68 +169,89 @@
if (ref($classlist->{$stu})) {
push(@okstudents,$stu);
} else {
- print "$stu not in classlist\n";
+ print STDOUT "$stu not in classlist\n";
}
}
} else {
@okstudents = sort(keys(%{$classlist}));
}
- foreach my $stu (@okstudents) {
- my ($stuname,$studom) = split(/:/,$stu);
- my $firstcorrect;
+ my $totalstringresp = 0;
+ my $totalcorrect = 0;
+ my $totalneutrinos = 0;
+ my $totalstu = scalar(@okstudents);
+ if ($totalsymbs) {
foreach my $symb (sort(keys(%strings))) {
- my %history= &Apache::lonnet::restore($symb,$cid,$studom,$stuname);
if (ref($strings{$symb}) eq 'ARRAY') {
- foreach my $item (@{$strings{$symb}}) {
- my ($prefix,$type) = split(/:/,$item);
- if ($history{$prefix.'.awarddetail'} eq 'EXACT_ANS') {
- my $correct = $history{$prefix.'.submission'};
- $correct =~ s/(^\s+|\s$)//g;
- my (@errors,$firstcorrect,@had_control_chars);
- foreach my $key (sort(keys(%history))) {
- if ($key =~ /^(\d+):\Q$prefix\E\.submission$/) {
- my $hist = $1;
- next if ($firstcorrect && $hist > $firstcorrect);
- my $current = $history{$key};
- $current =~ s/(^\s+|\s$)//g;
- if ($current eq $correct) {
- my $award = $history{"$hist:$prefix.awarddetail"};
- if ($award eq 'INCORRECT') {
- push(@errors,$hist);
- } elsif ($award eq 'EXACT_ANS') {
- if ($firstcorrect eq '') {
- $firstcorrect = $hist;
- } else {
- if ($hist < $firstcorrect) {
- $firstcorrect = $hist;
- }
- }
- }
- } elsif ($current =~ /[\000-\037]/) {
- $current =~ s/[\000-\037]//g;
+ $totalstringresp += scalar(@{$strings{$symb}});
+ }
+ }
+ foreach my $stu (@okstudents) {
+ my ($stuname,$studom) = split(/:/,$stu);
+ my $firstcorrect;
+ foreach my $symb (sort(keys(%strings))) {
+ my %history= &Apache::lonnet::restore($symb,$cid,$studom,$stuname);
+ if (ref($strings{$symb}) eq 'ARRAY') {
+ foreach my $prefix (@{$strings{$symb}}) {
+ if ($history{$prefix.'.awarddetail'} eq 'EXACT_ANS') {
+ my $correct = $history{$prefix.'.submission'};
+ $correct =~ s/(^\s+|\s$)//g;
+ my (@errors,$firstcorrect,@had_control_chars);
+ $totalcorrect ++ ;
+ foreach my $key (sort(keys(%history))) {
+ if ($key =~ /^(\d+):\Q$prefix\E\.submission$/) {
+ my $hist = $1;
+ next if ($firstcorrect && $hist > $firstcorrect);
+ my $current = $history{$key};
+ $current =~ s/(^\s+|\s$)//g;
if ($current eq $correct) {
my $award = $history{"$hist:$prefix.awarddetail"};
if ($award eq 'INCORRECT') {
push(@errors,$hist);
- push(@had_control_chars,$hist);
+ } elsif ($award eq 'EXACT_ANS') {
+ if ($firstcorrect eq '') {
+ $firstcorrect = $hist;
+ } else {
+ if ($hist < $firstcorrect) {
+ $firstcorrect = $hist;
+ }
+ }
+ }
+ } elsif ($current =~ /[\000-\037]/) {
+ $current =~ s/[\000-\037]//g;
+ if ($current eq $correct) {
+ my $award = $history{"$hist:$prefix.awarddetail"};
+ if ($award eq 'INCORRECT') {
+ push(@errors,$hist);
+ push(@had_control_chars,$hist);
+ }
}
}
}
}
- }
- if (@errors > 0) {
- @errors = sort {$a <=> $b} @errors;
- my $control_char_msg;
- if (@had_control_chars > 0) {
- @had_control_chars = sort {$a <=> $b} @had_control_chars;
- $control_char_msg = ' (control chars detected in: '.join(',',@had_control_chars).')';
+ if (@errors > 0) {
+ $totalneutrinos ++;
+ @errors = sort {$a <=> $b} @errors;
+ my $control_char_msg;
+ if (@had_control_chars > 0) {
+ @had_control_chars = sort {$a <=> $b} @had_control_chars;
+ $control_char_msg = ' (control chars detected in: '.join(',',@had_control_chars).')';
+ }
+ print $fh "$cid $stu ".join(',',@errors)."$control_char_msg vs $firstcorrect ||$correct|| $symb$prefix\n";
}
- print $fh "$cid $stu ".join(',',@errors)."$control_char_msg vs $firstcorrect ||$correct|| $symb$prefix\n";
}
}
}
}
}
+ my $pct;
+ if ($totalcorrect) {
+ $pct = 100.0 * $totalneutrinos/$totalcorrect;
+ $pct = sprintf("%.0f",$pct);
+ $pct = ' ('.$pct.'%)';
+ }
+ print STDOUT "$totalstringresp stringresponse item(s). $totalstu student(s) checked. Total EXACT_ANS submission(s): $totalcorrect. $totalneutrinos instance(s) of bug 5531 detected".$pct.".\n";
+ } else {
+ print STDOUT "No stringresponse items in course.\n";
}
delete($env{'request.course.id'});
delete($env{'request.role'});
--raeburn1287418622--