[system] / branches / gage_dev / webwork2 / lib / WeBWorK / ContentGenerator / Grades.pm Repository:
ViewVC logotype

Annotation of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Grades.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4811 - (view) (download) (as text)
Original Path: trunk/webwork2/lib/WeBWorK/ContentGenerator/Grades.pm

1 : gage 1858 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 : sh002i 3973 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4 : glarose 4811 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Grades.pm,v 1.31 2007/01/03 23:59:02 gage Exp $
5 : gage 1858 #
6 :     # This program is free software; you can redistribute it and/or modify it under
7 :     # the terms of either: (a) the GNU General Public License as published by the
8 :     # Free Software Foundation; either version 2, or (at your option) any later
9 :     # version, or (b) the "Artistic License" which comes with this package.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :     # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :     # Artistic License for more details.
15 :     ################################################################################
16 :    
17 :     package WeBWorK::ContentGenerator::Grades;
18 :     use base qw(WeBWorK::ContentGenerator);
19 :    
20 :     =head1 NAME
21 :    
22 :     WeBWorK::ContentGenerator::Instructor::Stats - Display statistics by user or
23 :     problem set.
24 :    
25 :     =cut
26 :    
27 :     use strict;
28 :     use warnings;
29 : gage 4235 #use CGI qw(-nosticky );
30 :     use WeBWorK::CGI;
31 : sh002i 3485 use WeBWorK::Debug;
32 : gage 1858 use WeBWorK::Utils qw(readDirectory list2hash max);
33 :    
34 :     sub initialize {
35 : sh002i 1889 my ($self) = @_;
36 :     my $r = $self->r;
37 :     my $db = $r->db;
38 :     my $ce = $r->ce;
39 :     my $authz = $r->authz;
40 :    
41 : gage 1858 my $userName = $r->param('user');
42 : sh002i 1889 my $effectiveUserName = defined($r->param("effectiveUser") ) ? $r->param("effectiveUser") : $userName;
43 : gage 1858 $self->{userName} = $userName;
44 :     $self->{studentName} = $effectiveUserName;
45 :     }
46 :    
47 :     sub body {
48 : sh002i 1889 my ($self) = @_;
49 :    
50 : gage 1858 $self->displayStudentStats($self->{studentName});
51 : sh002i 1889
52 : gage 1863 print $self->scoring_info();
53 : sh002i 1889
54 : gage 1858 return '';
55 :    
56 :     }
57 : gage 1863
58 :     ############################################
59 :     # Borrowed from SendMail.pm and Instructor.pm
60 :     ############################################
61 : sh002i 1889
62 : gage 1863 sub getRecord {
63 :     my $self = shift;
64 :     my $line = shift;
65 :     my $delimiter = shift;
66 :     $delimiter = ',' unless defined($delimiter);
67 :    
68 :     # Takes a delimited line as a parameter and returns an
69 :     # array. Note that all white space is removed. If the
70 :     # last field is empty, the last element of the returned
71 :     # array is also empty (unlike what the perl split command
72 :     # would return). E.G. @lineArray=&getRecord(\$delimitedLine).
73 :    
74 :     my(@lineArray);
75 :     $line.=$delimiter; # add 'A' to end of line so that
76 :     # last field is never empty
77 :     @lineArray = split(/\s*${delimiter}\s*/,$line);
78 : gage 3045 $lineArray[0] =~s/^\s*// if defined($lineArray[0]); # remove white space from first element
79 : gage 1863 @lineArray;
80 :     }
81 :    
82 :     sub scoring_info {
83 : sh002i 1889 my ($self) = @_;
84 :     my $r = $self->r;
85 :     my $db = $r->db;
86 :     my $ce = $r->ce;
87 :    
88 :     my $userName = $r->param('effectiveUser') || $r->param('user');
89 : gage 3395 my $userID = $r->param('user');
90 : sh002i 1889 my $ur = $db->getUser($userName);
91 :     my $emailDirectory = $ce->{courseDirs}->{email};
92 : gage 1863 my $filePath = "$emailDirectory/report_grades.msg";
93 :     my $merge_file = "report_grades_data.csv";
94 :     my $delimiter = ',';
95 : sh002i 4686 my $scoringDirectory = $ce->{courseDirs}->{scoring};
96 : gage 4736 return "There is no additional grade information. The spreadsheet file $filePath cannot be found." unless -e "$scoringDirectory/$merge_file";
97 : gage 1863 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
98 :     my $text;
99 :     my $header = '';
100 :     local(*FILE);
101 :     if (-e "$filePath" and -r "$filePath") {
102 :     open FILE, "$filePath" || return("Can't open $filePath");
103 :     while ($header !~ s/Message:\s*$//m and not eof(FILE)) {
104 :     $header .= <FILE>;
105 :     }
106 :     } else {
107 :     return("There is no additional grade information. <br> The message file $filePath cannot be found.")
108 :     }
109 :     $text = join( '', <FILE>);
110 :     close(FILE);
111 :    
112 : sh002i 3690 my $status_name = $ce->status_abbrev_to_name($ur->status);
113 :     $status_name = $ur->status unless defined $status_name;
114 :    
115 : gage 1863 my $SID = $ur->student_id;
116 :     my $FN = $ur->first_name;
117 :     my $LN = $ur->last_name;
118 :     my $SECTION = $ur->section;
119 :     my $RECITATION = $ur->recitation;
120 : sh002i 3690 my $STATUS = $status_name;
121 : gage 1863 my $EMAIL = $ur->email_address;
122 :     my $LOGIN = $ur->user_id;
123 :     my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
124 : gage 2996 unshift(@COL,""); ## this makes COL[1] the first column
125 :    
126 : gage 1863 my $endCol = @COL;
127 :     # for safety, only evaluate special variables
128 : sh002i 3690 # FIXME /e is not required for simple variable interpolation
129 : gage 1863 my $msg = $text;
130 :     $msg =~ s/(\$PAR)/<p>/ge;
131 :     $msg =~ s/(\$BR)/<br>/ge;
132 : gage 2874
133 :     $msg =~ s/\$SID/$SID/ge;
134 :     $msg =~ s/\$LN/$LN/ge;
135 :     $msg =~ s/\$FN/$FN/ge;
136 :     $msg =~ s/\$STATUS/$STATUS/ge;
137 :     $msg =~ s/\$SECTION/$SECTION/ge;
138 :     $msg =~ s/\$RECITATION/$RECITATION/ge;
139 :     $msg =~ s/\$EMAIL/$EMAIL/ge;
140 :     $msg =~ s/\$LOGIN/$LOGIN/ge;
141 :     if (defined($COL[1])) { # prevents extraneous error messages.
142 : gage 3395 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1] if defined($COL[$1])/ge
143 : gage 2874 }
144 :     else { # prevents extraneous $COL's in email message
145 :     $msg =~ s/\$COL\[(\-?\d+)\]//g
146 :     }
147 : gage 1863
148 : gage 2874 # old version
149 :     # $msg =~ s/(\$SID)/eval($1)/ge;
150 :     # $msg =~ s/(\$LN)/eval($1)/ge;
151 :     # $msg =~ s/(\$FN)/eval($1)/ge;
152 :     # $msg =~ s/(\$STATUS)/eval($1)/ge;
153 :     # $msg =~ s/(\$SECTION)/eval($1)/ge;
154 :     # $msg =~ s/(\$RECITATION)/eval($1)/ge;
155 :     # $msg =~ s/(\$EMAIL)/eval($1)/ge;
156 :     # $msg =~ s/(\$LOGIN)/eval($1)/ge;
157 :     # $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g;
158 :     # $msg =~ s/(\$COL\[.*?\])/eval($1)/ge;
159 : gage 1863
160 :     $msg =~ s/\r//g;
161 : gage 3395 $msg = "<pre>$msg</pre>";
162 :     $msg = qq!More scoring information goes here in [TMPL]/email/report_grades.msg. It
163 :     is merged with the file [Scoring]/report_grades_data.csv. <br>These files can be edited
164 :     using the "Email" link and the "Scoring Tools" link in the left margin.<p>!.$msg if ($r->authz->hasPermissions($userID, "access_instructor_tools"));
165 : gage 1863 return CGI::div(
166 : gage 3395 {style =>"background-color:#DDDDDD"}, $msg
167 : gage 1863 );
168 :     }
169 : sh002i 1889
170 : gage 1858 sub displayStudentStats {
171 : sh002i 1889 my ($self, $studentName) = @_;
172 :     my $r = $self->r;
173 :     my $db = $r->db;
174 :     my $ce = $r->ce;
175 :    
176 : gage 1858 my $courseName = $ce->{courseName};
177 :     my $studentRecord = $db->getUser($studentName); # checked
178 :     die "record for user $studentName not found" unless $studentRecord;
179 :     my $root = $ce->{webworkURLs}->{root};
180 :    
181 : glarose 4811 # first get all non-set-versions; listUserSets will return all
182 :     # homework assignments, plus the template gateway sets.
183 : sh002i 4518 # DBFIXME use iterator instead of setIDs
184 : glarose 4811 my @setIDs = sort( $db->listUserSets($studentName) );
185 :     # to figure out which of these are gateways (that is, versioned),
186 :     # we need to also have the actual (merged) set objects
187 :     my @sets = $db->getMergedSets( map {[$studentName, $_]} @setIDs );
188 :     # to be able to find the set objects later, make a handy hash
189 :     my %setsByID = ( map {$_->set_id => $_} @sets );
190 : glarose 3849
191 : gage 1858 my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name);
192 : glarose 3377 my $effectiveUser = $studentRecord->user_id();
193 : gage 1858 my $act_as_student_url = "$root/$courseName/?user=".$r->param("user").
194 : glarose 3377 "&effectiveUser=$effectiveUser&key=".$r->param("key");
195 : gage 1858
196 : glarose 4811 # before going through the table generating loop, find all the
197 :     # set versions for the sets in our list
198 :     my %setVersionsByID = ();
199 :     my @allSetIDs = ();
200 :     foreach my $set ( @sets ) {
201 :     my $setName = $set->set_id();
202 :     #
203 :     # FIXME: Here, as in many other locations, we assume that
204 :     # there is a one-to-one matching between versioned sets
205 :     # and gateways. we really should have two flags,
206 :     # $set->assignment_type and $set->versioned. I'm not
207 :     # adding that yet, however, so this will continue to
208 :     # use assignment_type...
209 :     #
210 :     if ( defined($set->assignment_type) &&
211 :     $set->assignment_type =~ /gateway/ ) {
212 :     my @vList = $db->listSetVersions($studentName,$setName);
213 :     # we have to have the merged set versions to
214 :     # know what each of their assignment types
215 :     # are (because proctoring can change)
216 :     my @setVersions = $db->getMergedSetVersions( map {[$studentName, $setName, $_]} @vList );
217 :    
218 :     # add the set versions to our list of sets
219 :     foreach ( @setVersions ) {
220 :     $setsByID{$_->set_id . ",v" . $_->version_id} = $_;
221 :     }
222 :     # flag the existence of set versions for this set
223 :     $setVersionsByID{$setName} = [ @vList ];
224 :     # and save the set names for display
225 :     push( @allSetIDs, $setName );
226 :     push( @allSetIDs, map { "$setName,v$_" } @vList );
227 :    
228 :     } else {
229 :     push( @allSetIDs, $setName );
230 :     $setVersionsByID{$setName} = "None";
231 :     }
232 :     }
233 :    
234 :    
235 :     # FIXME: why is the following not "print CGI::h3($fullName);"? Hmm.
236 : gage 1858 print CGI::h3($fullName ),
237 :    
238 :     ###############################################################
239 :     # Print table
240 :     ###############################################################
241 :    
242 :     # FIXME I'm assuming the problems are all the same
243 :     # FIXME what does this mean?
244 :    
245 :     my @rows;
246 :     my $max_problems=0;
247 :    
248 : glarose 4811 foreach my $setName (@allSetIDs) {
249 :     my $act_as_student_set_url = "$root/$courseName/$setName/?user=".$r->param("user").
250 : glarose 3377 "&effectiveUser=$effectiveUser&key=".$r->param("key");
251 : glarose 4811 my $set = $setsByID{ $setName };
252 :     my $setID = $set->set_id();
253 : glarose 3377
254 : glarose 4811 # now, if the set is a template gateway set and there
255 :     # are no versions, we acknowledge that the set exists
256 :     # and the student hasn't attempted it; otherwise, we
257 :     # skip it and let the versions speak for themselves
258 :     if ( defined( $set->assignment_type() ) &&
259 :     $set->assignment_type() =~ /gateway/ &&
260 :     ref( $setVersionsByID{ $setName } ) ) {
261 :     if ( @{$setVersionsByID{$setName}} ) {
262 :     next;
263 :     } else {
264 :     push( @rows, CGI::Tr({}, CGI::td(WeBWorK::ContentGenerator::underscore2nbsp($setID)),
265 :     CGI::td({colspan=>4}, CGI::em("No versions of this assignment have been taken."))) );
266 :     next;
267 :     }
268 :     }
269 : glarose 3377
270 : glarose 4811 # otherwise, if it's a gateway, adjust the act-as url
271 :     my $setIsVersioned = 0;
272 :     if ( defined( $set->assignment_type() ) &&
273 :     $set->assignment_type() =~ /gateway/ ) {
274 :     $setIsVersioned = 1;
275 :     if ( $set->assignment_type() eq 'proctored_gateway' ) {
276 :     $act_as_student_set_url =~ s/($courseName)\//$1\/proctored_quiz_mode\//;
277 :     } else {
278 :     $act_as_student_set_url =~ s/($courseName)\//$1\/quiz_mode\//;
279 :     }
280 : glarose 3377 }
281 :    
282 : glarose 4811 my $status = 0;
283 :     my $attempted = 0;
284 :     my $longStatus = '';
285 :     my $string = '';
286 :     my $twoString = '';
287 :     my $totalRight = 0;
288 :     my $total = 0;
289 : gage 1858 my $num_of_attempts = 0;
290 :    
291 : sh002i 3485 debug("Begin collecting problems for set $setName");
292 : glarose 4811 # DBFIXME: to collect the problem records, we have to know
293 :     # which merge routines to call. Should this really be an
294 :     # issue here? That is, shouldn't the database deal with
295 :     # it invisibly by detecting what the problem types are?
296 :     # oh well.
297 :     my @problemRecords = ();
298 :     if ( $setIsVersioned ) {
299 :     @problemRecords = $db->getAllMergedProblemVersions( $studentName, $setID, $set->version_id );
300 :     } else {
301 :     @problemRecords = $db->getAllMergedUserProblems( $studentName, $setID );
302 :     }
303 : sh002i 3485 debug("End collecting problems for set $setName");
304 : gage 1858
305 :     # FIXME the following line doesn't sort the problemRecords
306 :     #my @problems = sort {$a <=> $b } map { $_->problem_id } @problemRecords;
307 : sh002i 3485 debug("Begin sorting problems for set $setName");
308 : gage 1858 @problemRecords = sort {$a->problem_id <=> $b->problem_id } @problemRecords;
309 : sh002i 3485 debug("End sorting problems for set $setName");
310 : gage 1858 my $num_of_problems = @problemRecords;
311 :     my $max_problems = defined($num_of_problems) ? $num_of_problems : 0;
312 :    
313 :     # construct header
314 :    
315 :     foreach my $problemRecord (@problemRecords) {
316 :     my $prob = $problemRecord->problem_id;
317 :    
318 :     my $valid_status = 0;
319 :     unless (defined($problemRecord) ){
320 :     # warn "Can't find record for problem $prob in set $setName for $student";
321 :     # FIXME check the legitimate reasons why a student record might not be defined
322 :     next;
323 :     }
324 : toenail 2859 $status = $problemRecord->status || 0;
325 :     $attempted = $problemRecord->attempted;
326 :     my $num_correct = $problemRecord->num_incorrect || 0;
327 :     my $num_incorrect = $problemRecord->num_correct || 0;
328 :     $num_of_attempts += $num_correct + $num_incorrect;
329 :    
330 :     # This is a fail safe mechanism that makes sure that
331 :     # the problem is marked as attempted if the status has
332 :     # been set or if the problem has been attempted
333 : sh002i 4518 # DBFIXME this should happen in the database layer, not here!
334 : toenail 2859 if (!$attempted && ($status || $num_of_attempts)) {
335 :     $attempted = 1;
336 :     $problemRecord->attempted('1');
337 : glarose 4811 # DBFIXME: this is another case where it
338 :     # seems we shouldn't have to check for
339 :     # which routine to use here...
340 :     if ( $setIsVersioned ) {
341 :     $db->putProblemVersion($problemRecord);
342 :     } else {
343 :     $db->putUserProblem($problemRecord );
344 :     }
345 : toenail 2859 }
346 :    
347 : gage 1858 if (!$attempted){
348 :     $longStatus = '. ';
349 :     }
350 :     elsif ($status >= 0 and $status <=1 ) {
351 :     $valid_status = 1;
352 :     $longStatus = int(100*$status+.5);
353 :     if ($longStatus == 100) {
354 :     $longStatus = 'C ';
355 :     }
356 :     else {
357 :     $longStatus = &threeSpaceFill($longStatus);
358 :     }
359 :     }
360 :     else {
361 :     $longStatus = 'X ';
362 :     }
363 :    
364 :     $string .= $longStatus;
365 : gage 3133 $twoString .= threeSpaceFill($num_correct);
366 : gage 1858 my $probValue = $problemRecord->value;
367 : jj 2428 $probValue = 1 unless defined($probValue) and $probValue ne ""; # FIXME?? set defaults here?
368 : gage 1858 $total += $probValue;
369 :     $totalRight += round_score($status*$probValue) if $valid_status;
370 :     }
371 :    
372 : gage 3133
373 : gage 1858 my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0;
374 : sh002i 3694 my $successIndicator = ($avg_num_attempts && $total) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ;
375 : gage 1858
376 : gage 4259 push @rows, CGI::Tr({},
377 : jj 3634 CGI::td(CGI::a({-href=>$act_as_student_set_url}, WeBWorK::ContentGenerator::underscore2nbsp($setName))),
378 : gage 1858 CGI::td(sprintf("%0.2f",$totalRight)), # score
379 :     CGI::td($total), # out of
380 :     CGI::td(sprintf("%0.0f",100*$successIndicator)), # indicator
381 :     CGI::td("<pre>$string\n$twoString</pre>"), # problems
382 :     #CGI::td($studentRecord->section),
383 :     #CGI::td($studentRecord->recitation),
384 :     #CGI::td($studentRecord->user_id),
385 :    
386 :     );
387 :    
388 :     }
389 :    
390 :     my $problem_header = "";
391 :     foreach (1 .. $max_problems) {
392 :     $problem_header .= &threeSpaceFill($_);
393 :     }
394 :    
395 :     my $table_header = join("\n",
396 :     CGI::start_table({-border=>5,style=>'font-size:smaller'}),
397 : gage 4259 CGI::Tr({},
398 : gage 1858 CGI::th({ -align=>'center',},'Set'),
399 :     CGI::th({ -align=>'center', },'Score'),
400 :     CGI::th({ -align=>'center', },'Out'.CGI::br().'Of'),
401 :     CGI::th({ -align=>'center', },'Ind'),
402 :     CGI::th({ -align=>'center', },'Problems'.CGI::br().CGI::pre($problem_header)),
403 :     #CGI::th({ -align=>'center', },'Section'),
404 :     #CGI::th({ -align=>'center', },'Recitation'),
405 :     #CGI::th({ -align=>'center', },'login_name'),
406 :     #CGI::th({ -align=>'center', },'ID'),
407 :     )
408 :     );
409 :    
410 :     print $table_header;
411 :     print @rows;
412 :     print CGI::end_table();
413 :    
414 :     return "";
415 :     }
416 :    
417 :     #################################
418 :     # Utility function NOT a method
419 :     #################################
420 :     sub threeSpaceFill {
421 : jj 2963 my $num = shift @_ || 0;
422 :    
423 :     if (length($num)<=1) {return "$num".' ';}
424 :     elsif (length($num)==2) {return "$num".' ';}
425 :     else {return "## ";}
426 : gage 1858 }
427 :     sub round_score{
428 :     return shift;
429 :     }
430 : jj 2963
431 : gage 1858 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9