Parent Directory
| 
Revision Log
Fixed a bug that prevented scoring of sets assigned to fewer than all users
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator::Instructor::Scoring; 7 use base qw(WeBWorK::ContentGenerator::Instructor); 8 9 =head1 NAME 10 11 WeBWorK::ContentGenerator::Instructor::Scoring - Generate scoring data files 12 13 =cut 14 15 use strict; 16 use warnings; 17 use CGI qw(); 18 use WeBWorK::Utils qw(readFile formatDateTime); 19 use WeBWorK::DB::Utils qw(initializeUserProblem); 20 use WeBWorK::Timing; 21 22 sub initialize { 23 my ($self) = @_; 24 my $r = $self->{r}; 25 my $ce = $self->{ce}; 26 my $authz = $self->{authz}; 27 my $scoringDir = $ce->{courseDirs}->{scoring}; 28 my $courseName = $ce->{courseName}; 29 my $user = $r->param('user'); 30 31 unless ($authz->hasPermissions($user, "score_sets")) { 32 $self->{submitError} = "You aren't authorized to score problem sets"; 33 return; 34 } 35 36 if (defined $r->param('scoreSelected')) { 37 my @selected = $r->param('selectedSet'); 38 my @totals = (); 39 foreach my $setID (@selected) { 40 my @everything = $self->scoreSet($setID, "everything"); 41 my @normal = $self->everything2normal(@everything); 42 my @full = $self->everything2full(@everything); 43 my @info = $self->everything2info(@everything); 44 my @totalsColumn = $self->everything2totals(@everything); 45 @totals = @info unless @totals; 46 $self->appendColumns(\@totals, \@totalsColumn); 47 $self->writeCSV("$scoringDir/s${setID}scr.csv", @normal); 48 $self->writeCSV("$scoringDir/s${setID}ful.csv", @full); 49 } 50 $self->writeCSV("$scoringDir/${courseName}_totals.csv", @totals); 51 } 52 } 53 54 sub title { 55 "Scoring data for ".(shift)->{ce}->{courseName}; 56 } 57 58 sub body { 59 my ($self) = @_; 60 my $r = $self->{r}; 61 my $ce = $self->{ce}; 62 my $authz = $self->{authz}; 63 my $scoringDir = $ce->{courseDirs}->{scoring}; 64 my $courseName = $ce->{courseName}; 65 my $user = $r->param('user'); 66 67 if ($authz->hasPermissions($user, "score_sets")) { 68 my @selected = $r->param('selectedSet'); 69 print CGI::p("All of these files will also be made available for mail merge"); 70 foreach my $setID (@selected) { 71 print CGI::h2("$setID"); 72 foreach my $type ("scr", "ful") { 73 my $filename = "s$setID$type.csv"; 74 my $path = "$scoringDir/$filename"; 75 if (-f $path) { 76 print CGI::a({href=>"../scoringDownload/?getFile=${filename}&".$self->url_authen_args}, $filename); 77 print CGI::br(); 78 } 79 } 80 print CGI::hr(); 81 } 82 print CGI::h2("Totals"); 83 print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv"); 84 } 85 86 return ""; 87 } 88 89 # If, some day, it becomes possible to assign a different number of problems to each student, this code 90 # will have to be rewritten some. 91 # $format can be any of "normal", "full", "everything", "info", or "totals". An undefined value defaults to "normal" 92 # normal: student info, the status of each problem in the set, and a "totals" column 93 # full: student info, the status of each problem, and the number of correct and incorrect attempts 94 # everything: "full" plus a totals column 95 # info: student info columns only 96 # totals: total column only 97 sub scoreSet { 98 my ($self, $setID, $format) = @_; 99 my $db = $self->{db}; 100 my @scoringData; 101 102 $format = "normal" unless defined $format; 103 $format = "normal" unless $format eq "full" or $format eq "everything" or $format eq "totals" or $format eq "info"; 104 my $columnsPerProblem = ($format eq "full" or $format eq "everything") ? 3 : 1; 105 my $setRecord = $db->getGlobalSet($setID); 106 my %users; 107 foreach my $userID ($db->listUsers()) { 108 my $userRecord = $db->getUser($userID); 109 # The key is what we'd like to sort by. 110 $users{$userRecord->student_id} = $userRecord; 111 } 112 my @problemIDs = $db->listGlobalProblems($setID); 113 114 # Initialize a two-dimensional array of the proper size 115 for (my $i = 0; $i < keys(%users) + 7; $i++) { # 7 is how many descriptive fields there are in each column 116 push @scoringData, []; 117 } 118 119 unless ($format eq "totals") { 120 $scoringData[0][0] = "NO OF FIELDS"; 121 $scoringData[1][0] = "SET NAME"; 122 $scoringData[2][0] = "PROB NUMBER"; 123 $scoringData[3][0] = "DUE DATE"; 124 $scoringData[4][0] = "DUE TIME"; 125 $scoringData[5][0] = "PROB VALUE"; 126 } 127 128 my @userInfoColumnHeadings = ("STUDENT ID", "LAST NAME", "FIRST NAME", "SECTION", "RECITATION"); 129 my @userInfoFields = ("student_id", "last_name", "first_name", "section", "recitation"); 130 my @userKeys = sort keys %users; 131 132 # Write identifying information about the users 133 unless ($format eq "totals") { 134 for (my $field=0; $field < @userInfoFields; $field++) { 135 if ($field > 0) { 136 for (my $i = 0; $i < 6; $i++) { 137 $scoringData[$i][$field] = ""; 138 } 139 } 140 $scoringData[6][$field] = $userInfoColumnHeadings[$field]; 141 for (my $user = 0; $user < @userKeys; $user++) { 142 my $fieldName = $userInfoFields[$field]; 143 $scoringData[7 + $user][$field] = $users{$userKeys[$user]}->$fieldName; 144 } 145 } 146 } 147 return @scoringData if $format eq "info"; 148 149 # Write the problem data 150 my $dueDateString = formatDateTime($setRecord->due_date); 151 my ($dueDate, $dueTime) = $dueDateString =~ m/^([^\s]*)\s*([^\s]*)$/; 152 my $valueTotal = 0; 153 my %userStatusTotals = (); 154 for (my $problem = 0; $problem < @problemIDs; $problem++) { 155 my $globalProblem = $db->getGlobalProblem($setID, $problemIDs[$problem]); 156 my $column = 5 + $problem * $columnsPerProblem; 157 unless ($format eq "totals") { 158 $scoringData[0][$column] = ""; 159 $scoringData[1][$column] = $setRecord->set_id; 160 $scoringData[2][$column] = $globalProblem->problem_id; 161 $scoringData[3][$column] = $dueDate; 162 $scoringData[4][$column] = $dueTime; 163 $scoringData[5][$column] = $globalProblem->value; 164 $scoringData[6][$column] = "STATUS"; 165 if ($format eq "full" or $format eq "everything") { # Fill in with blanks, or maybe the problem number 166 for (my $row = 0; $row < 6; $row++) { 167 for (my $col = $column+1; $col <= $column + 2; $col++) { 168 if ($row == 2) { 169 $scoringData[$row][$col] = $globalProblem->problem_id; 170 } else { 171 $scoringData[$row][$col] = ""; 172 } 173 } 174 } 175 $scoringData[6][$column + 1] = "#corr"; 176 $scoringData[6][$column + 2] = "#incorr"; 177 } 178 } 179 $valueTotal += $globalProblem->value; 180 for (my $user = 0; $user < @userKeys; $user++) { 181 my $userProblem = $db->getMergedProblem($users{$userKeys[$user]}->user_id, $setID, $problemIDs[$problem]); 182 unless (defined $userProblem) { # assume an empty problem record if the problem isn't assigned to this user 183 $userProblem = $db->newUserProblem; 184 $userProblem->status(0); 185 $userProblem->value(0); 186 $userProblem->num_correct(0); 187 $userProblem->num_incorrect(0); 188 } 189 $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; 190 $userStatusTotals{$user} += $userProblem->status * $userProblem->value; 191 unless ($format eq "totals") { 192 $scoringData[7 + $user][$column] = $userProblem->status; 193 if ($format eq "full" or $format eq "everything") { 194 $scoringData[7 + $user][$column + 1] = $userProblem->num_correct; 195 $scoringData[7 + $user][$column + 2] = $userProblem->num_incorrect; 196 } 197 } 198 } 199 } 200 201 # write the status totals 202 unless ($format eq "full") { # Ironic, isn't it? 203 my $totalsColumn = $format eq "totals" ? 0 : 5 + @problemIDs * $columnsPerProblem; 204 $scoringData[0][$totalsColumn] = ""; 205 $scoringData[1][$totalsColumn] = $setRecord->set_id; 206 $scoringData[2][$totalsColumn] = ""; 207 $scoringData[3][$totalsColumn] = ""; 208 $scoringData[4][$totalsColumn] = ""; 209 $scoringData[5][$totalsColumn] = $valueTotal; 210 $scoringData[6][$totalsColumn] = "total"; 211 for (my $user = 0; $user < @userKeys; $user++) { 212 $scoringData[7+$user][$totalsColumn] = $userStatusTotals{$user}; 213 } 214 } 215 216 return @scoringData; 217 } 218 219 # Often it's more efficient to just get everything out of the database 220 # and then pick out what you want later. Hence, these "everything2*" functions 221 sub everything2info { 222 my ($self, @everything) = @_; 223 my @result = (); 224 foreach my $row (@everything) { 225 push @result, [@{$row}[0..4]]; 226 } 227 return @result; 228 } 229 230 sub everything2normal { 231 my ($self, @everything) = @_; 232 my @result = (); 233 foreach my $row (@everything) { 234 my @row = @$row; 235 my @newRow = (); 236 push @newRow, @row[0..4]; 237 for (my $i = 5; $i < @row; $i+=3) { 238 push @newRow, $row[$i]; 239 } 240 #push @newRow, $row[$#row]; 241 push @result, [@newRow]; 242 } 243 return @result; 244 } 245 246 sub everything2full { 247 my ($self, @everything) = @_; 248 my @result = (); 249 foreach my $row (@everything) { 250 push @result, [@{$row}[0..($#{$row}-1)]]; 251 } 252 return @result; 253 } 254 255 sub everything2totals { 256 my ($self, @everything) = @_; 257 my @result = (); 258 foreach my $row (@everything) { 259 push @result, [${$row}[$#{$row}]]; 260 } 261 return @result; 262 } 263 264 sub appendColumns { 265 my ($self, $a1, $a2) = @_; 266 my @a1 = @$a1; 267 my @a2 = @$a2; 268 for (my $i = 0; $i < @a1; $i++) { 269 push @{$a1[$i]}, @{$a2[$i]}; 270 } 271 } 272 273 # Reads a CSV file and returns an array of arrayrefs, each containing a 274 # row of data: 275 # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"]) 276 sub readCSV { 277 my ($self, $fileName) = @_; 278 my @result = (); 279 my @rows = split m/\n/, readFile($fileName); 280 foreach my $row (@rows) { 281 push @result, [split m/\s*,\s*/, $row]; 282 } 283 return @result; 284 } 285 286 # Write a CSV file from an array in the same format that readCSV produces 287 sub writeCSV { 288 my ($self, $filename, @csv) = @_; 289 290 my @lengths = (); 291 for (my $row = 0; $row < @csv; $row++) { 292 for (my $column = 0; $column < @{$csv[$row]}; $column++) { 293 $lengths[$column] = 0 unless defined $lengths[$column]; 294 $lengths[$column] = length $csv[$row][$column] if length $csv[$row][$column] > $lengths[$column]; 295 } 296 } 297 298 open my $fh, ">", $filename; 299 foreach my $row (@csv) { 300 my @rowPadded = (); 301 foreach (my $column = 0; $column < @$row; $column++) { 302 push @rowPadded, $self->pad($row->[$column], $lengths[$column] + 1); 303 } 304 print $fh join(",", @rowPadded); 305 print $fh "\n"; 306 } 307 close $fh; 308 } 309 310 # As soon as backwards compatability is no longer a concern and we don't expect to have 311 # to use old ww1.x code to read the output anymore, I recommend switching to using 312 # these routines, which are more versatile and compatable with other programs which 313 # deal with CSV files. 314 sub readStandardCSV { 315 my ($self, $fileName) = @_; 316 my @result = (); 317 my @rows = split m/\n/, readFile($fileName); 318 foreach my $row (@rows) { 319 push @result, [$self->splitQuoted($row)]; 320 } 321 return @result; 322 } 323 324 sub writeStandardCSV { 325 my ($self, $filename, @csv) = @_; 326 open my $fh, ">", $filename; 327 foreach my $row (@csv) { 328 print $fh (join ",", map {$self->quote($_)} @$row); 329 print $fh "\n"; 330 } 331 close $fh; 332 } 333 334 ### 335 336 # This particular unquote method unquotes (optionally) quoted strings in the 337 # traditional CSV style (double-quote for literal quote, etc.) 338 sub unquote { 339 my ($self, $string) = @_; 340 if ($string =~ m/^"(.*)"$/) { 341 $string = $1; 342 $string =~ s/""/"/; 343 } 344 return $string; 345 } 346 347 # Should you wish to treat whitespace differently, this routine has been designed 348 # to make it easy to do so. 349 sub splitQuoted { 350 my ($self, $string) = @_; 351 my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); 352 my @result = (); 353 my $continue = 1; 354 while ($continue) { 355 $string =~ m/\G(\s*)/gc; 356 $leadingSpace = $1; 357 $string =~ m/\G([^",]*)/gc; 358 $preText = $1; 359 if ($string =~ m/\G"((?:[^"]|"")*)"/gc) { 360 $quoted = $1; 361 } 362 $string =~ m/\G([^,]*?)(\s*)(,?)/gc; 363 ($postText, $trailingSpace, $continue) = ($1, $2, $3); 364 365 $preText = "" unless defined $preText; 366 $postText = "" unless defined $postText; 367 $quoted = "" unless defined $quoted; 368 369 if ($quoted and (not $preText and not $postText)) { 370 $quoted =~ s/""/"/; 371 $result = $quoted; 372 } else { 373 $result = "$preText$quoted$postText"; 374 } 375 push @result, $result; 376 } 377 return @result; 378 } 379 380 # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary. 381 sub quote { 382 my ($self, $string) = @_; 383 if ($string =~ m/[", ]/) { 384 $string =~ s/"/""/; 385 $string = "\"$string\""; 386 } 387 return $string; 388 } 389 390 sub pad { 391 my ($self, $string, $padTo) = @_; 392 my $spaces = $padTo - length $string; 393 return $string . " "x$spaces; 394 } 395 396 sub maxLength { 397 my ($self, $arrayRef) = @_; 398 my $max = 0; 399 foreach my $cell (@$arrayRef) { 400 $max = length $cell unless length $cell < $max; 401 } 402 return $max; 403 } 404 405 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |