Parent Directory
| 
Revision Log
HEAD backport: Added a line to check for empty records. The hope is that this fixes bug #733 (gage)
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Grades.pm,v 1.9.2.1 2004/11/14 03:03:42 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Grades; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::Stats - Display statistics by user or 23 problem set. 24 25 =cut 26 27 use strict; 28 use warnings; 29 use CGI qw(); 30 use WeBWorK::Utils qw(readDirectory list2hash max); 31 use WeBWorK::DB::Record::Set; 32 33 34 sub initialize { 35 my ($self) = @_; 36 my $r = $self->r; 37 my $db = $r->db; 38 my $ce = $r->ce; 39 my $authz = $r->authz; 40 41 my $userName = $r->param('user'); 42 my $effectiveUserName = defined($r->param("effectiveUser") ) ? $r->param("effectiveUser") : $userName; 43 $self->{userName} = $userName; 44 $self->{studentName} = $effectiveUserName; 45 } 46 47 sub body { 48 my ($self) = @_; 49 50 $self->displayStudentStats($self->{studentName}); 51 52 print $self->scoring_info(); 53 54 return ''; 55 56 } 57 58 ############################################ 59 # Borrowed from SendMail.pm and Instructor.pm 60 ############################################ 61 62 sub getRecord { 63 my $self = shift; 64 my $line = shift; 65 my $delimiter = shift; 66 $delimiter = ',' unless defined($delimiter); 67 68 # Takes a delimited line as a parameter and returns an 69 # array. Note that all white space is removed. If the 70 # last field is empty, the last element of the returned 71 # array is also empty (unlike what the perl split command 72 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 73 74 my(@lineArray); 75 $line.=$delimiter; # add 'A' to end of line so that 76 # last field is never empty 77 @lineArray = split(/\s*${delimiter}\s*/,$line); 78 $lineArray[0] =~s/^\s*// if defined($lineArray[0]); # remove white space from first element 79 @lineArray; 80 } 81 82 sub read_scoring_file { # used in SendMail and Grades?....? 83 my ($self, $fileName, $delimiter) = @_; 84 my $r = $self->r; 85 my $ce = $r->ce; 86 87 $delimiter = ',' unless defined($delimiter); 88 my $scoringDirectory= $ce->{courseDirs}->{scoring}; 89 my $filePath = "$scoringDirectory/$fileName"; 90 # Takes a delimited file as a parameter and returns an 91 # associative array with the first field as the key. 92 # Blank lines are skipped. White space is removed 93 my(@dbArray,$key,$dbString); 94 my %assocArray = (); 95 local(*FILE); 96 if ($fileName eq 'None') { 97 # do nothing 98 } elsif ( open(FILE, "$filePath") ) { 99 my $index=0; 100 while (<FILE>){ 101 unless ($_ =~ /\S/) {next;} ## skip blank lines 102 chomp; 103 @{$dbArray[$index]} =$self->getRecord($_,$delimiter); 104 $key =$dbArray[$index][0]; 105 $assocArray{$key}=$dbArray[$index]; 106 $index++; 107 } 108 close(FILE); 109 } elsif (-e $filePath) { 110 warn "Couldn't read file $filePath"; 111 } else { 112 } 113 return \%assocArray; 114 } 115 116 sub submission_error { 117 my $self = shift; 118 my $msg = join( " ", @_); 119 $self->{submitError} .= CGI::br().$msg; 120 return; 121 } 122 123 sub scoring_info { 124 my ($self) = @_; 125 my $r = $self->r; 126 my $db = $r->db; 127 my $ce = $r->ce; 128 129 my $userName = $r->param('effectiveUser') || $r->param('user'); 130 my $ur = $db->getUser($userName); 131 my $emailDirectory = $ce->{courseDirs}->{email}; 132 my $filePath = "$emailDirectory/report_grades.msg"; 133 my $merge_file = "report_grades_data.csv"; 134 my $delimiter = ','; 135 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 136 my $text; 137 my $header = ''; 138 local(*FILE); 139 if (-e "$filePath" and -r "$filePath") { 140 open FILE, "$filePath" || return("Can't open $filePath"); 141 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 142 $header .= <FILE>; 143 } 144 } else { 145 return("There is no additional grade information. <br> The message file $filePath cannot be found.") 146 } 147 $text = join( '', <FILE>); 148 close(FILE); 149 150 my $SID = $ur->student_id; 151 my $FN = $ur->first_name; 152 my $LN = $ur->last_name; 153 my $SECTION = $ur->section; 154 my $RECITATION = $ur->recitation; 155 my $STATUS = $ur->status; 156 my $EMAIL = $ur->email_address; 157 my $LOGIN = $ur->user_id; 158 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 159 unshift(@COL,""); ## this makes COL[1] the first column 160 161 my $endCol = @COL; 162 # for safety, only evaluate special variables 163 my $msg = $text; 164 $msg =~ s/(\$PAR)/<p>/ge; 165 $msg =~ s/(\$BR)/<br>/ge; 166 167 $msg =~ s/\$SID/$SID/ge; 168 $msg =~ s/\$LN/$LN/ge; 169 $msg =~ s/\$FN/$FN/ge; 170 $msg =~ s/\$STATUS/$STATUS/ge; 171 $msg =~ s/\$SECTION/$SECTION/ge; 172 $msg =~ s/\$RECITATION/$RECITATION/ge; 173 $msg =~ s/\$EMAIL/$EMAIL/ge; 174 $msg =~ s/\$LOGIN/$LOGIN/ge; 175 if (defined($COL[1])) { # prevents extraneous error messages. 176 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge 177 } 178 else { # prevents extraneous $COL's in email message 179 $msg =~ s/\$COL\[(\-?\d+)\]//g 180 } 181 182 # old version 183 # $msg =~ s/(\$SID)/eval($1)/ge; 184 # $msg =~ s/(\$LN)/eval($1)/ge; 185 # $msg =~ s/(\$FN)/eval($1)/ge; 186 # $msg =~ s/(\$STATUS)/eval($1)/ge; 187 # $msg =~ s/(\$SECTION)/eval($1)/ge; 188 # $msg =~ s/(\$RECITATION)/eval($1)/ge; 189 # $msg =~ s/(\$EMAIL)/eval($1)/ge; 190 # $msg =~ s/(\$LOGIN)/eval($1)/ge; 191 # $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 192 # $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 193 194 $msg =~ s/\r//g; 195 return CGI::div( 196 {style =>"background-color:#DDDDDD"}, "More scoring information goes here in \$emailDirectory/report_grades.msg. It 197 is merged with the file \$scoringDirectory/report_grades_data.csv. <p> 198 <pre>$msg</pre>" 199 ); 200 } 201 202 sub displayStudentStats { 203 my ($self, $studentName) = @_; 204 my $r = $self->r; 205 my $db = $r->db; 206 my $ce = $r->ce; 207 208 my $courseName = $ce->{courseName}; 209 my $studentRecord = $db->getUser($studentName); # checked 210 die "record for user $studentName not found" unless $studentRecord; 211 my $root = $ce->{webworkURLs}->{root}; 212 213 my @setIDs = sort $db->listUserSets($studentName); 214 my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name); 215 my $act_as_student_url = "$root/$courseName/?user=".$r->param("user"). 216 "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key"); 217 218 print CGI::h3($fullName ), 219 220 221 ############################################################### 222 # Print table 223 ############################################################### 224 225 # FIXME I'm assuming the problems are all the same 226 # FIXME what does this mean? 227 228 my @rows; 229 my $max_problems=0; 230 231 foreach my $setName (@setIDs) { 232 my $act_as_student_set_url = "$root/$courseName/$setName/?user=".$r->param("user"). 233 "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key"); 234 my $status = 0; 235 my $attempted = 0; 236 my $longStatus = ''; 237 my $string = ''; 238 my $twoString = ''; 239 my $totalRight = 0; 240 my $total = 0; 241 my $num_of_attempts = 0; 242 243 $WeBWorK::timer->continue("Begin collecting problems for set $setName") if defined($WeBWorK::timer); 244 my @problemRecords = $db->getAllUserProblems( $studentName, $setName ); 245 $WeBWorK::timer->continue("End collecting problems for set $setName") if defined($WeBWorK::timer); 246 247 # FIXME the following line doesn't sort the problemRecords 248 #my @problems = sort {$a <=> $b } map { $_->problem_id } @problemRecords; 249 $WeBWorK::timer->continue("Begin sorting problems for set $setName") if defined($WeBWorK::timer); 250 @problemRecords = sort {$a->problem_id <=> $b->problem_id } @problemRecords; 251 $WeBWorK::timer->continue("End sorting problems for set $setName") if defined($WeBWorK::timer); 252 my $num_of_problems = @problemRecords; 253 my $max_problems = defined($num_of_problems) ? $num_of_problems : 0; 254 255 # construct header 256 257 foreach my $problemRecord (@problemRecords) { 258 my $prob = $problemRecord->problem_id; 259 260 my $valid_status = 0; 261 unless (defined($problemRecord) ){ 262 # warn "Can't find record for problem $prob in set $setName for $student"; 263 # FIXME check the legitimate reasons why a student record might not be defined 264 next; 265 } 266 $status = $problemRecord->status || 0; 267 $attempted = $problemRecord->attempted; 268 my $num_correct = $problemRecord->num_incorrect || 0; 269 my $num_incorrect = $problemRecord->num_correct || 0; 270 $num_of_attempts += $num_correct + $num_incorrect; 271 272 # This is a fail safe mechanism that makes sure that 273 # the problem is marked as attempted if the status has 274 # been set or if the problem has been attempted 275 if (!$attempted && ($status || $num_of_attempts)) { 276 $attempted = 1; 277 $problemRecord->attempted('1'); 278 $db->putUserProblem($problemRecord); 279 } 280 281 if (!$attempted){ 282 $longStatus = '. '; 283 } 284 elsif ($status >= 0 and $status <=1 ) { 285 $valid_status = 1; 286 $longStatus = int(100*$status+.5); 287 if ($longStatus == 100) { 288 $longStatus = 'C '; 289 } 290 else { 291 $longStatus = &threeSpaceFill($longStatus); 292 } 293 } 294 else { 295 $longStatus = 'X '; 296 } 297 298 my $incorrect = $problemRecord->num_incorrect; 299 $string .= $longStatus; 300 $twoString .= threeSpaceFill($incorrect); 301 my $probValue = $problemRecord->value; 302 $probValue = 1 unless defined($probValue) and $probValue ne ""; # FIXME?? set defaults here? 303 $total += $probValue; 304 $totalRight += round_score($status*$probValue) if $valid_status; 305 } 306 307 308 my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0; 309 my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; 310 311 push @rows, CGI::Tr( 312 CGI::td(CGI::a({-href=>$act_as_student_set_url}, underscore2nbsp($setName))), 313 CGI::td(sprintf("%0.2f",$totalRight)), # score 314 CGI::td($total), # out of 315 CGI::td(sprintf("%0.0f",100*$successIndicator)), # indicator 316 CGI::td("<pre>$string\n$twoString</pre>"), # problems 317 #CGI::td($studentRecord->section), 318 #CGI::td($studentRecord->recitation), 319 #CGI::td($studentRecord->user_id), 320 321 ); 322 323 } 324 325 my $problem_header = ""; 326 foreach (1 .. $max_problems) { 327 $problem_header .= &threeSpaceFill($_); 328 } 329 330 my $table_header = join("\n", 331 CGI::start_table({-border=>5,style=>'font-size:smaller'}), 332 CGI::Tr( 333 CGI::th({ -align=>'center',},'Set'), 334 CGI::th({ -align=>'center', },'Score'), 335 CGI::th({ -align=>'center', },'Out'.CGI::br().'Of'), 336 CGI::th({ -align=>'center', },'Ind'), 337 CGI::th({ -align=>'center', },'Problems'.CGI::br().CGI::pre($problem_header)), 338 #CGI::th({ -align=>'center', },'Section'), 339 #CGI::th({ -align=>'center', },'Recitation'), 340 #CGI::th({ -align=>'center', },'login_name'), 341 #CGI::th({ -align=>'center', },'ID'), 342 ) 343 ); 344 345 print $table_header; 346 print @rows; 347 print CGI::end_table(); 348 349 return ""; 350 } 351 352 ################################# 353 # Utility function NOT a method 354 ################################# 355 sub threeSpaceFill { 356 my $num = shift @_ || 0; 357 358 if (length($num)<=1) {return "$num".' ';} 359 elsif (length($num)==2) {return "$num".' ';} 360 else {return "## ";} 361 } 362 sub round_score{ 363 return shift; 364 } 365 366 sub underscore2nbsp { 367 my $str = shift; 368 $str =~ s/_/ /g; 369 return($str); 370 } 371 372 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |