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