Parent Directory
| 
Revision Log
merging with localization files in trunk
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Grades.pm,v 1.35 2007/07/10 14:41:54 glarose Exp $ 5 # 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 #use CGI qw(-nosticky ); 30 use WeBWorK::CGI; 31 use WeBWorK::Debug; 32 use WeBWorK::Utils qw(readDirectory list2hash max); 33 use WeBWorK::Localize; 34 sub initialize { 35 my ($self) = @_; 36 my $r = $self->r; 37 my $db = $r->db; 38 my $ce = $r->ce; 39 my $authz = $r->authz; 40 41 my $userName = $r->param('user'); 42 my $effectiveUserName = defined($r->param("effectiveUser") ) ? $r->param("effectiveUser") : $userName; 43 $self->{userName} = $userName; 44 $self->{studentName} = $effectiveUserName; 45 } 46 47 sub body { 48 my ($self) = @_; 49 50 $self->displayStudentStats($self->{studentName}); 51 52 print $self->scoring_info(); 53 54 return ''; 55 56 } 57 58 ############################################ 59 # Borrowed from SendMail.pm and Instructor.pm 60 ############################################ 61 62 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 $lineArray[0] =~s/^\s*// if defined($lineArray[0]); # remove white space from first element 79 @lineArray; 80 } 81 82 sub scoring_info { 83 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 my $userID = $r->param('user'); 90 my $ur = $db->getUser($userName); 91 my $emailDirectory = $ce->{courseDirs}->{email}; 92 my $filePath = "$emailDirectory/report_grades.msg"; 93 my $merge_file = "report_grades_data.csv"; 94 my $delimiter = ','; 95 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 96 return "There is no additional grade information. The spreadsheet file $filePath cannot be found." unless -e "$scoringDirectory/$merge_file"; 97 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 my $status_name = $ce->status_abbrev_to_name($ur->status); 113 $status_name = $ur->status unless defined $status_name; 114 115 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 my $STATUS = $status_name; 121 my $EMAIL = $ur->email_address; 122 my $LOGIN = $ur->user_id; 123 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 124 unshift(@COL,""); ## this makes COL[1] the first column 125 126 my $endCol = @COL; 127 # for safety, only evaluate special variables 128 # FIXME /e is not required for simple variable interpolation 129 my $msg = $text; 130 $msg =~ s/(\$PAR)/<p>/ge; 131 $msg =~ s/(\$BR)/<br>/ge; 132 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 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1] if defined($COL[$1])/ge 143 } 144 else { # prevents extraneous $COL's in email message 145 $msg =~ s/\$COL\[(\-?\d+)\]//g 146 } 147 148 # 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 160 $msg =~ s/\r//g; 161 $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 return CGI::div( 166 {style =>"background-color:#DDDDDD"}, $msg 167 ); 168 } 169 170 sub displayStudentStats { 171 my ($self, $studentName) = @_; 172 my $r = $self->r; 173 my $db = $r->db; 174 my $ce = $r->ce; 175 my $authz = $r->authz; 176 177 my $courseName = $ce->{courseName}; 178 my $studentRecord = $db->getUser($studentName); # checked 179 die "record for user $studentName not found" unless $studentRecord; 180 my $root = $ce->{webworkURLs}->{root}; 181 182 ###################################################################### 183 # Get all sets (including versions of gateway quizzes) assigned to this user 184 ###################################################################### 185 186 # first get all non-versioned-sets; listUserSets will return all 187 # homework assignments, plus the template gateway sets. 188 # DBFIXME use iterator instead of setIDs 189 my @setIDs = sort( $db->listUserSets($studentName) ); 190 # to figure out which of these are gateways (that is, versioned), 191 # we need to also have the actual (merged) set objects 192 my @sets = $db->getMergedSets( map {[$studentName, $_]} @setIDs ); 193 # to be able to find the set objects later, make a handy hash 194 my %setsByID = ( map {$_->set_id => $_} @sets ); 195 196 ###################################################### 197 # before going through the table generating loop, find all the 198 # set versions for the sets in our list 199 # 200 # info for refactoring: 201 # input: list of regular sets (from $db->getMergedSets(studentID, setID ) 202 # input: $db 203 # input: \%setsByID 204 # output: \%setVersionsByID --- a pointer to a list of version names. 205 # update: \%setsByID --- indexed by full set name, value is the set record 206 # output: \@allSetIDs -- full names of sets (the gateway template and the versioned tests) 207 ############################################# 208 my %setVersionsByID = (); 209 my @allSetIDs = (); 210 foreach my $set ( @sets ) { 211 my $setName = $set->set_id(); 212 # 213 # FIXME: Here, as in many other locations, we assume that 214 # there is a one-to-one matching between versioned sets 215 # and gateways. we really should have two flags, 216 # $set->assignment_type and $set->versioned. I'm not 217 # adding that yet, however, so this will continue to 218 # use assignment_type... 219 # 220 if ( defined($set->assignment_type) && 221 $set->assignment_type =~ /gateway/ ) { 222 my @vList = $db->listSetVersions($studentName,$setName); 223 # we have to have the merged set versions to 224 # know what each of their assignment types 225 # are (because proctoring can change) 226 my @setVersions = $db->getMergedSetVersions( map {[$studentName, $setName, $_]} @vList ); 227 228 # add the set versions to our list of sets 229 foreach ( @setVersions ) { 230 $setsByID{$_->set_id . ",v" . $_->version_id} = $_; 231 } 232 # flag the existence of set versions for this set 233 $setVersionsByID{$setName} = [ @vList ]; 234 # and save the set names for display 235 push( @allSetIDs, $setName ); 236 push( @allSetIDs, map { "$setName,v$_" } @vList ); 237 238 } else { 239 push( @allSetIDs, $setName ); 240 $setVersionsByID{$setName} = "None"; 241 } 242 } 243 244 245 ######################################################################################### 246 my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name); 247 my $effectiveUser = $studentRecord->user_id(); 248 my $act_as_student_url = "$root/$courseName/?user=".$r->param("user"). 249 "&effectiveUser=$effectiveUser&key=".$r->param("key"); 250 251 252 # FIXME: why is the following not "print CGI::h3($fullName);"? Hmm. 253 print CGI::h3($fullName ), 254 255 ############################################################### 256 # Print table 257 ############################################################### 258 259 # FIXME I'm assuming the problems are all the same 260 # FIXME what does this mean? 261 262 my @rows; 263 my $max_problems=0; 264 265 foreach my $setName (@allSetIDs) { 266 my $act_as_student_set_url = "$root/$courseName/$setName/?user=".$r->param("user"). 267 "&effectiveUser=$effectiveUser&key=".$r->param("key"); 268 my $set = $setsByID{ $setName }; 269 my $setID = $set->set_id(); #FIXME setName and setID should be the same 270 271 # now, if the set is a template gateway set and there 272 # are no versions, we acknowledge that the set exists 273 # and the student hasn't attempted it; otherwise, we 274 # skip it and let the versions speak for themselves 275 if ( defined( $set->assignment_type() ) && 276 $set->assignment_type() =~ /gateway/ && 277 ref( $setVersionsByID{ $setName } ) ) { 278 if ( @{$setVersionsByID{$setName}} ) { 279 next; 280 } else { 281 push( @rows, CGI::Tr({}, CGI::td(WeBWorK::ContentGenerator::underscore2nbsp($setID)), 282 CGI::td({colspan=>4}, CGI::em("No versions of this assignment have been taken."))) ); 283 next; 284 } 285 } 286 # if the set has hide_score set, then we need to skip printing 287 # the score as well 288 if ( defined( $set->hide_score ) && 289 ( ! $authz->hasPermissions($r->param("user"), "view_hidden_work") && 290 ( $set->hide_score eq 'Y' || 291 ($set->hide_score eq 'BeforeAnswerDate' && time < $set->answer_date) ) ) ) { 292 push( @rows, CGI::Tr({}, CGI::td(WeBWorK::ContentGenerator::underscore2nbsp("${setID}_(test_" . $set->version_id . ")")), 293 CGI::td({colspan=>4}, CGI::em("Display of scores for this set is not allowed."))) ); 294 next; 295 } 296 297 # otherwise, if it's a gateway, adjust the act-as url 298 my $setIsVersioned = 0; 299 if ( defined( $set->assignment_type() ) && 300 $set->assignment_type() =~ /gateway/ ) { 301 $setIsVersioned = 1; 302 if ( $set->assignment_type() eq 'proctored_gateway' ) { 303 $act_as_student_set_url =~ s/($courseName)\//$1\/proctored_quiz_mode\//; 304 } else { 305 $act_as_student_set_url =~ s/($courseName)\//$1\/quiz_mode\//; 306 } 307 } 308 ############################################## 309 # this segment requires @problemRecords, $db, $set 310 # and $studentName, $setName, 311 ############################################## 312 my ($status, 313 $longStatus, 314 $string, 315 $twoString, 316 $totalRight, 317 $total, 318 $num_of_attempts, 319 $num_of_problems); 320 321 ($status, 322 $longStatus, 323 $string, 324 $twoString, 325 $totalRight, 326 $total, 327 $num_of_attempts, 328 $num_of_problems 329 ) = grade_set( $db, $set, $setName, $studentName, $setIsVersioned); 330 331 # warn "status $status longStatus $longStatus string $string twoString 332 # $twoString totalRight $totalRight, total $total num_of_attempts $num_of_attempts 333 # num_of_problems $num_of_problems setName $setName"; 334 335 my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0; 336 my $successIndicator = ($avg_num_attempts && $total) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; 337 338 $max_problems = ($max_problems<$num_of_problems)? $num_of_problems:$max_problems; 339 340 # prettify versioned set display 341 $setName =~ s/(.+),v(\d+)$/${1}_(test_$2)/; 342 343 push @rows, CGI::Tr({}, 344 CGI::td(CGI::a({-href=>$act_as_student_set_url}, WeBWorK::ContentGenerator::underscore2nbsp($setName))), 345 CGI::td(sprintf("%0.2f",$totalRight)), # score 346 CGI::td($total), # out of 347 #CGI::td(sprintf("%0.0f",100*$successIndicator)), # indicator -- leave this out 348 CGI::td("<pre>$string\n$twoString</pre>"), # problems 349 #CGI::td($studentRecord->section), 350 #CGI::td($studentRecord->recitation), 351 #CGI::td($studentRecord->user_id), 352 353 ); 354 355 } 356 357 my $problem_header = ""; 358 foreach (1 .. $max_problems) { 359 $problem_header .= &threeSpaceFill($_); 360 } 361 362 my $table_header = join("\n", 363 CGI::start_table({-border=>5,style=>'font-size:smaller'}), 364 CGI::Tr({}, 365 CGI::th({ -align=>'center',},'Set'), 366 CGI::th({ -align=>'center', },'Score'), 367 CGI::th({ -align=>'center', },'Out'.CGI::br().'Of'), 368 #CGI::th({ -align=>'center', },'Ind'), # -- leave out indicator column 369 CGI::th({ -align=>'center', },'Problems'.CGI::br().CGI::pre($problem_header)), 370 #CGI::th({ -align=>'center', },'Section'), 371 #CGI::th({ -align=>'center', },'Recitation'), 372 #CGI::th({ -align=>'center', },'login_name'), 373 #CGI::th({ -align=>'center', },'ID'), 374 ) 375 ); 376 377 378 379 print $table_header; 380 print @rows; 381 print CGI::end_table(); 382 383 return ""; 384 } 385 ################ 386 # TASKS 387 ################### 388 389 # grading utility 390 # provides a formatted line for presenting grades ( 391 ############################################################### 392 # 17-2-motion-velocity 0.00 7 0 . . . . . . . 393 # 0 0 0 0 0 0 0 394 ############################################################### 395 # requires = grade_set( $db, $set, $setName, $studentName, $setIsVersioned); 396 # returns my ($status, 397 # $longStatus, 398 # $string, 399 # $twoString, 400 # $totalRight, 401 # $total, 402 # $num_of_attempts, 403 # $num_of_problems) = grade_set(...); 404 ######################### 405 # ######################################## 406 # # Notes for factoring the calculation in this loop. 407 # # 408 # # Inputs include: 409 # # @problemRecords 410 # # returns 411 # # $num_of_attempts 412 # # $status 413 # # updates 414 # # $number_of_students_attempting_problem{$probID}++; 415 # # @{ $attempts_list_for_problem{$probID} } 416 # # $number_of_attempts_for_problem{$probID} 417 # # $total_num_of_attempts_for_set 418 # # $correct_answers_for_problem{$probID} 419 # # 420 # # $string (formatting output) 421 # # $twoString (more formatted output) 422 # # $longtwo (a combination of $string and $twostring) 423 # # $total 424 # # $totalRight 425 # ################################### 426 sub grade_set { 427 428 my ($db, $set, $setName, $studentName, $setIsVersioned) = @_; 429 430 my $setID = $set->set_id(); #FIXME setName and setID should be the same 431 432 my $status = 0; 433 my $longStatus = ''; 434 my $string = ''; 435 my $twoString = ''; 436 my $totalRight = 0; 437 my $total = 0; 438 my $num_of_attempts = 0; 439 440 debug("Begin collecting problems for set $setName"); 441 # DBFIXME: to collect the problem records, we have to know 442 # which merge routines to call. Should this really be an 443 # issue here? That is, shouldn't the database deal with 444 # it invisibly by detecting what the problem types are? 445 # oh well. 446 447 my @problemRecords = $db->getAllMergedUserProblems( $studentName, $setID ); 448 my $num_of_problems = @problemRecords || 0; 449 my $max_problems = defined($num_of_problems) ? $num_of_problems : 0; 450 451 if ( $setIsVersioned ) { 452 @problemRecords = $db->getAllMergedProblemVersions( $studentName, $setID, $set->version_id ); 453 } # use versioned problems instead (assume that each version has the same number of problems. 454 455 debug("End collecting problems for set $setName"); 456 457 #################### 458 # Resort records 459 ##################### 460 @problemRecords = sort {$a->problem_id <=> $b->problem_id } @problemRecords; 461 462 # for gateway/quiz assignments we have to be careful about 463 # the order in which the problems are displayed, because 464 # they may be in a random order 465 if ( $set->problem_randorder ) { 466 my @newOrder = (); 467 my @probOrder = (0..$#problemRecords); 468 # we reorder using a pgrand based on the set psvn 469 my $pgrand = PGrandom->new(); 470 $pgrand->srand( $set->psvn ); 471 while ( @probOrder ) { 472 my $i = int($pgrand->rand(scalar(@probOrder))); 473 push( @newOrder, $probOrder[$i] ); 474 splice(@probOrder, $i, 1); 475 } 476 # now $newOrder[i] = pNum-1, where pNum is the problem 477 # number to display in the ith position on the test 478 # for sorting, invert this mapping: 479 my %pSort = map {($newOrder[$_]+1)=>$_} (0..$#newOrder); 480 481 @problemRecords = sort {$pSort{$a->problem_id} <=> $pSort{$b->problem_id}} @problemRecords; 482 } 483 484 485 ####################################################### 486 # construct header 487 488 foreach my $problemRecord (@problemRecords) { 489 my $prob = $problemRecord->problem_id; 490 491 unless (defined($problemRecord) ){ 492 # warn "Can't find record for problem $prob in set $setName for $student"; 493 # FIXME check the legitimate reasons why a student record might not be defined 494 next; 495 } 496 497 $status = $problemRecord->status || 0; 498 my $attempted = $problemRecord->attempted; 499 my $num_correct = $problemRecord->num_correct || 0; 500 my $num_incorrect = $problemRecord->num_incorrect || 0; 501 $num_of_attempts += $num_correct + $num_incorrect; 502 503 ####################################################### 504 # This is a fail safe mechanism that makes sure that 505 # the problem is marked as attempted if the status has 506 # been set or if the problem has been attempted 507 # DBFIXME this should happen in the database layer, not here! 508 if (!$attempted && ($status || $num_of_attempts)) { 509 $attempted = 1; 510 $problemRecord->attempted('1'); 511 # DBFIXME: this is another case where it 512 # seems we shouldn't have to check for 513 # which routine to use here... 514 if ( $setIsVersioned ) { 515 $db->putProblemVersion($problemRecord); 516 } else { 517 $db->putUserProblem($problemRecord ); 518 } 519 } 520 ###################################################### 521 522 # sanity check that the status (score) is 523 # between 0 and 1 524 my $valid_status = ($status>=0 && $status<=1)?1:0; 525 526 ########################################### 527 # Determine the string $longStatus which 528 # will display the student's current score 529 ########################################### 530 531 if (!$attempted){ 532 $longStatus = '.'; 533 } elsif ($valid_status) { 534 $longStatus = int(100*$status+.5); 535 $longStatus='C' if ($longStatus==100); 536 } else { 537 $longStatus = 'X'; 538 } 539 540 $string .= threeSpaceFill($longStatus); 541 $twoString .= threeSpaceFill($num_incorrect); 542 my $probValue = $problemRecord->value; 543 $probValue = 1 unless defined($probValue) and $probValue ne ""; # FIXME?? set defaults here? 544 $total += $probValue; 545 $totalRight += round_score($status*$probValue) if $valid_status; 546 547 # 548 # # initialize the number of correct answers 549 # # for this problem if the value has not been 550 # # defined. 551 # $correct_answers_for_problem{$probID} = 0 552 # unless defined($correct_answers_for_problem{$probID}); 553 554 # 555 # # add on the scores for this problem 556 # if (defined($attempted) and $attempted) { 557 # $number_of_students_attempting_problem{$probID}++; 558 # push( @{ $attempts_list_for_problem{$probID} } , $num_of_attempts); 559 # $number_of_attempts_for_problem{$probID} += $num_of_attempts; 560 # $h_problemData{$probID} = $num_incorrect; 561 # $total_num_of_attempts_for_set += $num_of_attempts; 562 # $correct_answers_for_problem{$probID} += $status; 563 # } 564 565 } # end of problem record loop 566 567 568 569 return($status, 570 $longStatus, 571 $string, 572 $twoString, 573 $totalRight, 574 $total, 575 $num_of_attempts, 576 $num_of_problems 577 ); 578 } 579 ################################# 580 # Utility function NOT a method 581 ################################# 582 sub threeSpaceFill { 583 my $num = shift @_ || 0; 584 585 if (length($num)<=1) {return "$num".' ';} 586 elsif (length($num)==2) {return "$num".' ';} 587 else {return "## ";} 588 } 589 sub round_score{ 590 return shift; 591 } 592 593 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |