--- loncom/homework/grades.pm 2007/07/04 18:37:30 1.419
+++ loncom/homework/grades.pm 2007/10/09 09:16:04 1.447
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.419 2007/07/04 18:37:30 www Exp $
+# $Id: grades.pm,v 1.447 2007/10/09 09:16:04 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -45,36 +45,103 @@ use LONCAPA;
use POSIX qw(floor);
-my %oldessays=();
+
my %perm=();
+my %bubble_lines_per_response = (); # no. bubble lines for each response.
+ # index is "symb.part_id"
+
+my %first_bubble_line = (); # First bubble line no. for each bubble.
+
+# Save and restore the bubble lines array to the form env.
+
+
+sub save_bubble_lines {
+
+ foreach my $line (keys(%bubble_lines_per_response)) {
+ $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line};
+ $env{"form.scantron.first_bubble_line.$line"} =
+ $first_bubble_line{$line};
+ }
+}
+
+
+sub restore_bubble_lines {
+ my $line = 0;
+ %bubble_lines_per_response = ();
+ while ($env{"form.scantron.bubblelines.$line"}) {
+ my $value = $env{"form.scantron.bubblelines.$line"};
+ $bubble_lines_per_response{$line} = $value;
+ $first_bubble_line{$line} =
+ $env{"form.scantron.first_bubble_line.$line"};
+ $line++;
+ }
+
+}
+
+# Given the parsed scanline, get the response for
+# 'answer' number n:
+
+sub get_response_bubbles {
+ my ($parsed_line, $response) = @_;
+
+ my $bubble_line = $first_bubble_line{$response};
+ my $bubble_lines= $bubble_linse_per_response{$response};
+ my $selected = "";
+
+ for (my $bline = 0; $bline < $bubble_lines; $bline++) {
+ $selected .= $$parsed_line{"scantron.$bubble_line.answer"};
+ $bubble_line++;
+ }
+ return $selected;
+}
+
# ----- These first few routines are general use routines.----
+
+# Return the number of occurences of a pattern in a string.
+
+sub occurence_count {
+ my ($string, $pattern) = @_;
+
+ my @matches = ($string =~ /$pattern/g);
+
+ return scalar(@matches);
+}
+
+
+# Take a string known to have digits and convert all the
+# digits into letters in the range J,A..I.
+
+sub digits_to_letters {
+ my ($input) = @_;
+
+ my @alphabet = ('J', 'A'..'I');
+
+ my @input = split(//, $input);
+ my $output ='';
+ for (my $i = 0; $i < scalar(@input); $i++) {
+ if ($input[$i] =~ /\d/) {
+ $output .= $alphabet[$input[$i]];
+ } else {
+ $output .= $input[$i];
+ }
+ }
+ return $output;
+}
+
#
# --- Retrieve the parts from the metadata file.---
sub getpartlist {
my ($symb) = @_;
- my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
- my $partorder = &Apache::lonnet::metadata($url, 'partorder');
- my @parts;
- if ($partorder) {
- for my $part (split (/,/,$partorder)) {
- if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) {
- push(@parts, $part);
- }
- }
- } else {
- my $metadata = &Apache::lonnet::metadata($url, 'packages');
- foreach (split(/\,/,$metadata)) {
- if ($_ =~ /^part_(.*)$/) {
- if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) {
- push(@parts, $1);
- }
- }
- }
- }
+
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $res = $navmap->getBySymb($symb);
+ my $partlist = $res->parts();
+ my $url = $res->src();
+ my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+
my @stores;
- foreach my $part (@parts) {
- my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+ foreach my $part (@{ $partlist }) {
foreach my $key (@metakeys) {
if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
}
@@ -195,22 +262,54 @@ sub showResourceInfo {
return $result,$responseType,$hdgrade,$partlist,$handgrade;
}
+sub reset_caches {
+ &reset_analyze_cache();
+ &reset_perm();
+}
-sub get_order {
- my ($partid,$respid,$symb,$uname,$udom)=@_;
- my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
- $url=&Apache::lonnet::clutter($url);
- my $subresult=&Apache::lonnet::ssi($url,
- ('grade_target' => 'analyze'),
- ('grade_domain' => $udom),
- ('grade_symb' => $symb),
- ('grade_courseid' =>
- $env{'request.course.id'}),
- ('grade_username' => $uname));
- (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
- my %analyze=&Apache::lonnet::str2hash($subresult);
- return ($analyze{"$partid.$respid.shown"});
+{
+ my %analyze_cache;
+
+ sub reset_analyze_cache {
+ undef(%analyze_cache);
+ }
+
+ sub get_analyze {
+ my ($symb,$uname,$udom)=@_;
+ my $key = "$symb\0$uname\0$udom";
+ return $analyze_cache{$key} if (exists($analyze_cache{$key}));
+
+ my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
+ $url=&Apache::lonnet::clutter($url);
+ my $subresult=&Apache::lonnet::ssi($url,
+ ('grade_target' => 'analyze'),
+ ('grade_domain' => $udom),
+ ('grade_symb' => $symb),
+ ('grade_courseid' =>
+ $env{'request.course.id'}),
+ ('grade_username' => $uname));
+ (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
+ my %analyze=&Apache::lonnet::str2hash($subresult);
+ return $analyze_cache{$key} = \%analyze;
+ }
+
+ sub get_order {
+ my ($partid,$respid,$symb,$uname,$udom)=@_;
+ my $analyze = &get_analyze($symb,$uname,$udom);
+ return $analyze->{"$partid.$respid.shown"};
+ }
+
+ sub get_radiobutton_correct_foil {
+ my ($partid,$respid,$symb,$uname,$udom)=@_;
+ my $analyze = &get_analyze($symb,$uname,$udom);
+ foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
+ if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
+ return $foil;
+ }
+ }
+ }
}
+
#--- Clean response type for display
#--- Currently filters option/rank/radiobutton/match/essay/Task
# response types only.
@@ -259,11 +358,11 @@ sub cleanRecord {
} elsif ($response eq 'radiobutton') {
my %answer=&Apache::lonnet::str2hash($answer);
my ($toprow,$bottomrow);
- my $correct=($order->[0])+1;
- for (my $i=1;$i<=$#$order;$i++) {
- my $foil=$order->[$i];
+ my $correct =
+ &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
+ foreach my $foil (@$order) {
if (exists($answer{$foil})) {
- if ($i == $correct) {
+ if ($foil eq $correct) {
$toprow.='
true
';
} else {
$toprow.='
true
';
@@ -327,7 +426,10 @@ sub cleanRecord {
$result.='';
return $result;
}
-
+ } elsif ( $response =~ m/(?:numerical|formula)/) {
+ $answer =
+ &Apache::loncommon::format_previous_attempt_value('submission',
+ $answer);
}
return $answer;
}
@@ -373,6 +475,7 @@ COMMONJSFUNCTIONS
sub getclasslist {
my ($getsec,$filterlist) = @_;
my @getsec;
+ my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
if (!ref($getsec)) {
if ($getsec ne '' && $getsec ne 'all') {
@getsec=($getsec);
@@ -402,8 +505,8 @@ sub getclasslist {
my $status =
$classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
# filter students according to status selected
- if ($filterlist && $env{'form.Status'} ne 'Any') {
- if ($env{'form.Status'} ne $status) {
+ if ($filterlist && (!($stu_status =~ /Any/))) {
+ if (!($stu_status =~ $status)) {
delete ($classlist->{$student});
next;
}
@@ -485,6 +588,7 @@ sub student_gradeStatus {
# Shows a student's view of problem and submission
sub jscriptNform {
my ($symb) = @_;
+ my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
my $jscript='
+GRADINGMENUJS
+ &commonJSfunctions($request);
+ my $result='
Manual Grading/View Submission
';
+ my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
+ $result.=$table;
+ my (undef,$sections) = &getclasslist('all','0');
+ my $savedState = &savedState();
+ my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
+ my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
+ my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
+ my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
+
+ $result.=''."\n";
return $result;
}
@@ -6124,15 +7520,17 @@ sub gather_clicker_ids {
# Set up a couple variables.
my $username_idx = &Apache::loncoursedata::CL_SNAME();
my $domain_idx = &Apache::loncoursedata::CL_SDOM();
+ my $status_idx = &Apache::loncoursedata::CL_STATUS();
foreach my $student (keys(%$classlist)) {
-
+ if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
my $username = $classlist->{$student}->[$username_idx];
my $domain = $classlist->{$student}->[$domain_idx];
my $clickers =
(&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
$id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
if (exists($clicker_ids{$id})) {
$clicker_ids{$id}.=','.$username.':'.$domain;
} else {
@@ -6155,6 +7553,7 @@ sub gather_adv_clicker_ids {
(&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
$id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
if (exists($clicker_ids{$id})) {
$clicker_ids{$id}.=','.$puname.':'.$pudom;
} else {
@@ -6301,6 +7700,7 @@ sub process_clicker_file {
$correct_id=~tr/a-z/A-Z/;
$correct_id=~s/\s//gs;
$correct_id=~s/^[\#0]+//;
+ $correct_id=~s/[\-\:]//g;
if ($correct_id) {
$correct_ids{$correct_id}='specified';
}
@@ -6365,6 +7765,8 @@ ENDHEADER
}
$result.=' '.&mt('Found [_1] question(s)',$number).' '.
''.
+ &mt('Awarding [_1] percent for corrion(s)',$number).' '.
+ ''.
&mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
$env{'form.pcorrect'},$env{'form.pincorrect'}).
' ';
@@ -6384,8 +7786,21 @@ ENDHEADER
$result.="\n".'';
$correct_count++;
} elsif ($clicker_ids{$id}) {
- $result.="\n".'';
- $student_count++;
+ if ($clicker_ids{$id}=~/\,/) {
+# More than one user with the same clicker!
+ $result.="\n".&mt('Clicker registered more than once').": ".$id." ";
+ $result.="\n".''.
+ "';
+ $unknown_count++;
+ } else {
+# Good: found one and only one user with the right clicker
+ $result.="\n".'';
+ $student_count++;
+ }
} else {
$result.="\n".&mt('Unregistered Clicker')." ".$id." ";
$result.="\n".''.
@@ -6405,6 +7820,9 @@ ENDHEADER
$result.=' '.&mt("Found [_1] entries for grading!",$correct_count).'';
}
}
+ if ($number<1) {
+ $errormsg.="Found no questions.";
+ }
if ($errormsg) {
$result.=' '.&mt($errormsg).'';
} else {
@@ -6446,25 +7864,29 @@ sub interwrite_eval {
my ($questiontitles,$responses)=@_;
my $number=0;
my $errormsg='';
+ my $skipline=1;
+ my $questionnumber=0;
+ my %idresponses=();
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[0] eq 'Question') {
- for (my $i=3;$i<$#entries;$i+=6) {
- $$questiontitles[$number]=$entries[$i];
- $number++;
- }
- }
- if ($entries[0]=~/^\#/) {
- my $id=$entries[0];
- my @idresponses;
- $id=~s/^[\#0]+//;
- for (my $i=0;$i<$number;$i++) {
- my $idx=3+$i*6;
- push(@idresponses,$entries[$idx]);
- }
- $$responses{$id}=join(',',@idresponses);
+ if ($entries[1] eq 'Time') { $skipline=0; next; }
+ if ($entries[1] eq 'Response') { $skipline=1; }
+ next if $skipline;
+ if ($entries[0]!=$questionnumber) {
+ $questionnumber=$entries[0];
+ $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
+ $number++;
}
+ my $id=$entries[4];
+ $id=~s/^[\#0]+//;
+ $id=~s/^v\d*\://i;
+ $id=~s/[\-\:]//g;
+ $idresponses{$id}[$number]=$entries[6];
+ }
+ foreach my $id (keys %idresponses) {
+ $$responses{$id}=join(',',@{$idresponses{$id}});
+ $$responses{$id}=~s/^\s*\,//;
}
return ($errormsg,$number);
}
@@ -6521,8 +7943,19 @@ ENDHEADER
my $pincorrect=$env{'form.pincorrect'};
my $storecount=0;
foreach my $key (keys(%env)) {
+ my $user='';
if ($key=~/^form\.student\:(.*)$/) {
- my $user=$1;
+ $user=$1;
+ }
+ if ($key=~/^form\.unknown\:(.*)$/) {
+ my $id=$1;
+ if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
+ $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
+ } elsif ($env{'form.multi'.$id}) {
+ $user=$env{'form.multi'.$id};
+ }
+ }
+ if ($user) {
my @answer=split(/\,/,$env{$key});
my $sum=0;
for (my $i=0;$i<$number;$i++) {
@@ -6565,7 +7998,7 @@ ENDHEADER
sub handler {
my $request=$_[0];
- &reset_perm();
+ &reset_caches();
if ($env{'browser.mathml'}) {
&Apache::loncommon::content_type($request,'text/xml');
} else {
@@ -6577,9 +8010,12 @@ sub handler {
my $symb=&get_symb($request,1);
my @commands=&Apache::loncommon::get_env_multiple('form.command');
my $command=$commands[0];
+
if ($#commands > 0) {
&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
}
+
+
$request->print(&Apache::loncommon::start_page('Grading'));
if ($symb eq '' && $command eq '') {
if ($env{'user.adv'}) {
@@ -6620,7 +8056,9 @@ sub handler {
} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
&processGroup($request);
} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
- $request->print(&gradingmenu($request));
+ $request->print(&grading_menu($request));
+ } elsif ($command eq 'submit_options' && $perm{'vgr'}) {
+ $request->print(&submit_options($request));
} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
$request->print(&viewgrades($request));
} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
@@ -6655,6 +8093,7 @@ sub handler {
} elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
$request->print(&csvuploadassign($request));
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
+ &Apache::lonnet::logthis("Selecting pyhase");
$request->print(&scantron_selectphase($request));
} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
$request->print(&scantron_do_warning($request));
@@ -6678,6 +8117,7 @@ sub handler {
}
}
$request->print(&Apache::loncommon::end_page());
+ &reset_caches();
return '';
}