Parent Directory
| 
Revision Log
Now generates scoring data files in response to requests from the set list. There is no confirmation that this has been done, yet, though. If it returns an "empty" page, it worked, and you can see the scoring files.
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 20 sub initialize { 21 my ($self) = @_; 22 my $r = $self->{r}; 23 my $ce = $self->{ce}; 24 25 my $scoringDir = $ce->{courseDirs}->{scoring}; 26 if (defined $r->param('scoreSelected')) { 27 my @selected = $r->param('selectedSet'); 28 foreach my $setID (@selected) { 29 my @scoringData = $self->scoreSet($setID); 30 $self->writeCSV("$scoringDir/s${setID}scr.csv", @scoringData); 31 } 32 } 33 } 34 35 36 # If, some day, it becomes possible to assign a different number of problems to each student, this code 37 # will have to be rewritten some. 38 # $format can be any of "normal", "full", "info", or "totals". An undefined value defaults to "normal" 39 # normal: student info, the status of each problem in the set, and a "totals" column 40 # full: student info, the status of each problem, and the number of correct and incorrect attempts 41 # info: student info columns only 42 # totals: total column only 43 sub scoreSet { 44 my ($self, $setID, $format) = @_; 45 my $db = $self->{db}; 46 my @scoringData; 47 48 $format = "normal" unless defined $format; 49 $format = "normal" unless $format eq "full" or $format eq "totals" or $format eq "info"; 50 my $columnsPerProblem = $format eq "full" ? 3 : 1; 51 my $setRecord = $db->getGlobalSet($setID); 52 my %users; 53 foreach my $userID ($db->listUsers) { 54 my $userRecord = $db->getUser($userID); 55 # The key is what we'd like to sort by. 56 $users{$userRecord->student_id} = $userRecord; 57 } 58 my @problemIDs = $db->listGlobalProblems($setID); 59 60 # Initialize a two-dimensional array of the proper size 61 for (my $i = 0; $i < keys(%users) + 7; $i++) { # 7 is how many descriptive fields there are in each column 62 push @scoringData, []; 63 } 64 65 66 unless ($format eq "totals") { 67 $scoringData[0][0] = "NO OF FIELDS"; 68 $scoringData[1][0] = "SET NAME"; 69 $scoringData[2][0] = "PROB NUMBER"; 70 $scoringData[3][0] = "DUE DATE"; 71 $scoringData[4][0] = "DUE TIME"; 72 $scoringData[5][0] = "PROB VALUE"; 73 } 74 75 my @userInfoColumnHeadings = ("STUDENT ID", "LAST NAME", "FIRST NAME", "SECTION", "RECITATION"); 76 my @userInfoFields = ("student_id", "last_name", "first_name", "section", "recitation"); 77 my @userKeys = sort keys %users; 78 79 # Write identifying information about the users 80 unless ($format eq "totals") { 81 for (my $field=0; $field < @userInfoFields; $field++) { 82 if ($field > 0) { 83 for (my $i = 0; $i < 6; $i++) { 84 $scoringData[$i][$field] = ""; 85 } 86 } 87 $scoringData[6][$field] = $userInfoColumnHeadings[$field]; 88 for (my $user = 0; $user < @userKeys; $user++) { 89 my $fieldName = $userInfoFields[$field]; 90 $scoringData[7 + $user][$field] = $users{$userKeys[$user]}->$fieldName; 91 } 92 } 93 } 94 return @scoringData if $format eq "info"; 95 96 # Write the problem data 97 my $dueDateString = formatDateTime($setRecord->due_date); 98 my ($dueDate, $dueTime) = $dueDateString =~ m/^([^\s]*)\s*([^\s]*)$/; 99 my $valueTotal = 0; 100 my %userStatusTotals = (); 101 for (my $problem = 0; $problem < @problemIDs; $problem++) { 102 my $globalProblem = $db->getGlobalProblem($setID, $problemIDs[$problem]); 103 my $column = 5 + $problem * $columnsPerProblem; 104 unless ($format eq "totals") { 105 $scoringData[0][$column] = ""; 106 $scoringData[1][$column] = $setRecord->set_id; 107 $scoringData[2][$column] = $globalProblem->problem_id; 108 $scoringData[3][$column] = $dueDate; 109 $scoringData[4][$column] = $dueTime; 110 $scoringData[5][$column] = $globalProblem->value; 111 $scoringData[6][$column] = "STATUS"; 112 if ($format eq "full") { # Fill in with blanks, or maybe the problem number 113 for (my $row = 0; $row < 6; $row++) { 114 for (my $col = $column+1; $col <= $column + 2; $col++) { 115 if ($row == 2) { 116 $scoringData[$row][$col] = $globalProblem->problem_id; 117 } else { 118 $scoringData[$row][$col] = ""; 119 } 120 } 121 } 122 $scoringData[6][$column + 1] = "#corr"; 123 $scoringData[6][$column + 2] = "#incorr"; 124 } 125 } 126 $valueTotal += $globalProblem->value; 127 for (my $user = 0; $user < @userKeys; $user++) { 128 my $userProblem = $db->getMergedProblem($users{$userKeys[$user]}->user_id, $setID, $problemIDs[$problem]); 129 $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; 130 $userStatusTotals{$user} += $userProblem->status * $userProblem->value; 131 unless ($format eq "totals") { 132 $scoringData[7 + $user][$column] = $userProblem->status; 133 if ($format eq "full") { 134 $scoringData[7 + $user][$column + 1] = $userProblem->num_correct; 135 $scoringData[7 + $user][$column + 2] = $userProblem->num_incorrect; 136 } 137 } 138 } 139 } 140 141 # write the status totals 142 unless ($format eq "full") { # Ironic, isn't it? 143 my $totalsColumn = $format eq "totals" ? 0 : 5 + @problemIDs * $columnsPerProblem; 144 $scoringData[0][$totalsColumn] = ""; 145 $scoringData[1][$totalsColumn] = $setRecord->set_id; 146 $scoringData[2][$totalsColumn] = ""; 147 $scoringData[3][$totalsColumn] = ""; 148 $scoringData[4][$totalsColumn] = ""; 149 $scoringData[5][$totalsColumn] = $valueTotal; 150 $scoringData[6][$totalsColumn] = "total"; 151 for (my $user = 0; $user < @userKeys; $user++) { 152 $scoringData[7+$user][$totalsColumn] = $userStatusTotals{$user}; 153 } 154 } 155 156 return @scoringData; 157 } 158 159 # Reads a CSV file and returns an array of arrayrefs, each containing a 160 # row of data: 161 # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"]) 162 sub readCSV { 163 my ($self, $fileName) = @_; 164 my @result = (); 165 my @rows = split m/\n/, readFile($fileName); 166 foreach my $row (@rows) { 167 push @result, [split m/\s*,\s*/, $row]; 168 } 169 return @result; 170 } 171 172 # Write a CSV file from an array in the same format that readCSV produces 173 sub writeCSV { 174 my ($self, $filename, @csv) = @_; 175 176 my @lengths = (); 177 for (my $row = 0; $row < @csv; $row++) { 178 for (my $column = 0; $column < @{$csv[$row]}; $column++) { 179 $lengths[$column] = 0 unless defined $lengths[$column]; 180 $lengths[$column] = length $csv[$row][$column] if length $csv[$row][$column] > $lengths[$column]; 181 } 182 } 183 184 open my $fh, ">", $filename; 185 foreach my $row (@csv) { 186 my @rowPadded = (); 187 foreach (my $column = 0; $column < @$row; $column++) { 188 push @rowPadded, $self->pad($row->[$column], $lengths[$column] + 1); 189 } 190 print $fh join(",", @rowPadded); 191 print $fh "\n"; 192 } 193 close $fh; 194 } 195 196 # As soon as backwards compatability is no longer a concern and we don't expect to have 197 # to use old ww1.x code to read the output anymore, I recommend switching to using 198 # these routines, which are more versatile and compatable with other programs which 199 # deal with CSV files. 200 sub readStandardCSV { 201 my ($self, $fileName) = @_; 202 my @result = (); 203 my @rows = split m/\n/, readFile($fileName); 204 foreach my $row (@rows) { 205 push @result, [$self->splitQuoted($row)]; 206 } 207 return @result; 208 } 209 210 sub writeStandardCSV { 211 my ($self, $filename, @csv) = @_; 212 open my $fh, ">", $filename; 213 foreach my $row (@csv) { 214 print $fh (join ",", map {$self->quote($_)} @$row); 215 print $fh "\n"; 216 } 217 close $fh; 218 } 219 220 ### 221 222 # This particular unquote method unquotes (optionally) quoted strings in the 223 # traditional CSV style (double-quote for literal quote, etc.) 224 sub unquote { 225 my ($self, $string) = @_; 226 if ($string =~ m/^"(.*)"$/) { 227 $string = $1; 228 $string =~ s/""/"/; 229 } 230 return $string; 231 } 232 233 # Should you wish to treat whitespace differently, this routine has been designed 234 # to make it easy to do so. 235 sub splitQuoted { 236 my ($self, $string) = @_; 237 my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); 238 my @result = (); 239 my $continue = 1; 240 while ($continue) { 241 $string =~ m/\G(\s*)/gc; 242 $leadingSpace = $1; 243 $string =~ m/\G([^",]*)/gc; 244 $preText = $1; 245 if ($string =~ m/\G"((?:[^"]|"")*)"/gc) { 246 $quoted = $1; 247 } 248 $string =~ m/\G([^,]*?)(\s*)(,?)/gc; 249 ($postText, $trailingSpace, $continue) = ($1, $2, $3); 250 251 $preText = "" unless defined $preText; 252 $postText = "" unless defined $postText; 253 $quoted = "" unless defined $quoted; 254 255 if ($quoted and (not $preText and not $postText)) { 256 $quoted =~ s/""/"/; 257 $result = $quoted; 258 } else { 259 $result = "$preText$quoted$postText"; 260 } 261 push @result, $result; 262 } 263 return @result; 264 } 265 266 # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary. 267 sub quote { 268 my ($self, $string) = @_; 269 if ($string =~ m/[", ]/) { 270 $string =~ s/"/""/; 271 $string = "\"$string\""; 272 } 273 return $string; 274 } 275 276 sub pad { 277 my ($self, $string, $padTo) = @_; 278 my $spaces = $padTo - length $string; 279 return $string . " "x$spaces; 280 } 281 282 sub maxLength { 283 my ($self, $arrayRef) = @_; 284 my $max = 0; 285 foreach my $cell (@$arrayRef) { 286 $max = length $cell unless length $cell < $max; 287 } 288 return $max; 289 } 290 291 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |