| … | |
… | |
| 14 | |
14 | |
| 15 | use strict; |
15 | use strict; |
| 16 | use warnings; |
16 | use warnings; |
| 17 | use CGI qw(); |
17 | use CGI qw(); |
| 18 | use WeBWorK::Utils qw(readFile formatDateTime); |
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 | |
| 19 | |
35 | |
| 20 | # If, some day, it becomes possible to assign a different number of problems to each student, this code |
36 | # If, some day, it becomes possible to assign a different number of problems to each student, this code |
| 21 | # will have to be rewritten some. |
37 | # will have to be rewritten some. |
| 22 | # $format can be any of "normal", "full", "info", or "totals". An undefined value defaults to "normal" |
38 | # $format can be any of "normal", "full", "info", or "totals". An undefined value defaults to "normal" |
| 23 | # normal: student info, the status of each problem in the set, and a "totals" column |
39 | # normal: student info, the status of each problem in the set, and a "totals" column |
| … | |
… | |
| 27 | sub scoreSet { |
43 | sub scoreSet { |
| 28 | my ($self, $setID, $format) = @_; |
44 | my ($self, $setID, $format) = @_; |
| 29 | my $db = $self->{db}; |
45 | my $db = $self->{db}; |
| 30 | my @scoringData; |
46 | my @scoringData; |
| 31 | |
47 | |
|
|
48 | $format = "normal" unless defined $format; |
| 32 | $format = "normal" unless $format eq "full" or $format eq "totals" or $format eq "info"; |
49 | $format = "normal" unless $format eq "full" or $format eq "totals" or $format eq "info"; |
| 33 | my $columnsPerProblem = $format eq "full" ? 3 : 1; |
50 | my $columnsPerProblem = $format eq "full" ? 3 : 1; |
| 34 | my $setRecord = $db->getGlobalSet($setID); |
51 | my $setRecord = $db->getGlobalSet($setID); |
| 35 | my %users; |
52 | my %users; |
| 36 | foreach my $userID ($db->listUsers) { |
53 | foreach my $userID ($db->listUsers) { |
| … | |
… | |
| 106 | $scoringData[6][$column + 2] = "#incorr"; |
123 | $scoringData[6][$column + 2] = "#incorr"; |
| 107 | } |
124 | } |
| 108 | } |
125 | } |
| 109 | $valueTotal += $globalProblem->value; |
126 | $valueTotal += $globalProblem->value; |
| 110 | for (my $user = 0; $user < @userKeys; $user++) { |
127 | for (my $user = 0; $user < @userKeys; $user++) { |
| 111 | # getting the UserProblem is quicker, and we only need user-only data, anyway |
|
|
| 112 | my $userProblem = $db->getUserProblem($users{$userKeys[$user]}->user_id, $setID, $problemIDs[$problem]); |
128 | my $userProblem = $db->getMergedProblem($users{$userKeys[$user]}->user_id, $setID, $problemIDs[$problem]); |
| 113 | $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; |
129 | $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; |
| 114 | $userStatusTotals{$user} += $userProblem->status * $userProblem->value; |
130 | $userStatusTotals{$user} += $userProblem->status * $userProblem->value; |
| 115 | unless ($format eq "totals") { |
131 | unless ($format eq "totals") { |
| 116 | $scoringData[7 + $user][$column] = $userProblem->status; |
132 | $scoringData[7 + $user][$column] = $userProblem->status; |
| 117 | if ($format eq "full") { |
133 | if ($format eq "full") { |