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