Parent Directory
| 
Revision Log
Correct logical bug in GatewayQuiz module that didn't honor time_limit_cap, gracefully deal with null values of problem_value in the database (which occurs when creating a set from the Library Browser), round reported allowed time (which may be useful when time_limit_cap is specified).
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/ProblemSets.pm,v 1.94 2010/01/31 02:31:04 apizer 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::ProblemSets; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::ProblemSets - Display a list of built problem sets. 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI qw(-nosticky ); 29 use WeBWorK::CGI; 30 use WeBWorK::Debug; 31 use WeBWorK::Utils qw(readFile sortByName path_is_subdir); 32 33 # what do we consider a "recent" problem set? 34 use constant RECENT => 2*7*24*60*60 ; # Two-Weeks in seconds 35 36 sub info { 37 my ($self) = @_; 38 my $r = $self->r; 39 my $ce = $r->ce; 40 my $db = $r->db; 41 my $urlpath = $r->urlpath; 42 my $authz = $r->authz; 43 44 my $courseID = $urlpath->arg("courseID"); 45 my $user = $r->param("user"); 46 47 my $course_info = $ce->{courseFiles}->{course_info}; 48 49 if (defined $course_info and $course_info) { 50 my $course_info_path = $ce->{courseDirs}->{templates} . "/$course_info"; 51 52 print CGI::start_div({class=>"info-box", id=>"InfoPanel"}); 53 54 # deal with instructor crap 55 my $editorURL; 56 if ($authz->hasPermissions($user, "access_instructor_tools")) { 57 if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile") { 58 $course_info_path = $r->param("sourceFilePath"); 59 $course_info_path = $ce->{courseDirs}{templates}.'/'.$course_info_path unless $course_info_path =~ m!^/!; 60 die "sourceFilePath is unsafe!" unless path_is_subdir($course_info_path, $ce->{courseDirs}->{templates}); 61 $self->addmessage(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $course_info_path)); 62 } 63 64 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", courseID => $courseID); 65 $editorURL = $self->systemLink($editorPage, params => { file_type => "course_info" }); 66 } 67 68 if ($editorURL) { 69 print CGI::h2("Course Info", CGI::a({href=>$editorURL, target=>"WW_Editor"}, "[edit]")); 70 } else { 71 print CGI::h2("Course Info"); 72 } 73 74 if (-f $course_info_path) { #check that it's a plain file 75 my $text = eval { readFile($course_info_path) }; 76 if ($@) { 77 print CGI::div({class=>"ResultsWithError"}, 78 CGI::p("$@"), 79 ); 80 } else { 81 print $text; 82 } 83 } 84 85 print CGI::end_div(); 86 87 return ""; 88 } 89 } 90 sub help { # non-standard help, since the file path includes the course name 91 my $self = shift; 92 my $args = shift; 93 my $name = $args->{name}; 94 $name = lc('course home') unless defined($name); 95 $name =~ s/\s/_/g; 96 $self->helpMacro($name); 97 } 98 sub initialize { 99 100 101 102 # get result and send to message 103 my ($self) = @_; 104 my $r = $self->r; 105 my $authz = $r->authz; 106 my $urlpath = $r->urlpath; 107 108 my $user = $r->param("user"); 109 my $effectiveUser = $r->param("effectiveUser"); 110 if ($authz->hasPermissions($user, "access_instructor_tools")) { 111 # get result and send to message 112 my $status_message = $r->param("status_message"); 113 $self->addmessage(CGI::p("$status_message")) if $status_message; 114 115 116 } 117 } 118 sub body { 119 my ($self) = @_; 120 my $r = $self->r; 121 my $ce = $r->ce; 122 my $db = $r->db; 123 my $authz = $r->authz; 124 my $urlpath = $r->urlpath; 125 126 my $user = $r->param("user"); 127 my $effectiveUser = $r->param("effectiveUser"); 128 my $sort = $r->param("sort") || "status"; 129 130 my $courseName = $urlpath->arg("courseID"); 131 132 my $hardcopyPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Hardcopy", courseID => $courseName); 133 my $actionURL = $self->systemLink($hardcopyPage, authen => 0); # no authen info for form action 134 135 # we have to get sets and versioned sets separately 136 # DBFIXME don't get ID lists, use WHERE clauses and iterators 137 my @setIDs = $db->listUserSets($effectiveUser); 138 my @userSetIDs = map {[$effectiveUser, $_]} @setIDs; 139 140 debug("Begin collecting merged sets"); 141 my @sets = $db->getMergedSets( @userSetIDs ); 142 143 debug("Begin fixing merged sets"); 144 145 # Database fix (in case of undefined published values) 146 # this may take some extra time the first time but should NEVER need to be run twice 147 # this is only necessary because some people keep holding to ww1.9 which did not have a published field 148 # DBFIXME this should be in the database layer (along with other "fixes" of its ilk) 149 foreach my $set (@sets) { 150 # make sure published is set to 0 or 1 151 if ( $set and $set->published ne "0" and $set->published ne "1") { 152 my $globalSet = $db->getGlobalSet($set->set_id); 153 $globalSet->published("1"); # defaults to published 154 $db->putGlobalSet($globalSet); 155 $set = $db->getMergedSet($effectiveUser, $set->set_id); 156 } else { 157 die "set $set not defined" unless $set; 158 } 159 } 160 161 foreach my $set (@sets) { 162 # make sure enable_reduced_scoring is set to 0 or 1 163 if ( $set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") { 164 my $globalSet = $db->getGlobalSet($set->set_id); 165 $globalSet->enable_reduced_scoring("0"); # defaults to disabled 166 $db->putGlobalSet($globalSet); 167 $set = $db->getMergedSet($effectiveUser, $set->set_id); 168 } else { 169 die "set $set not defined" unless $set; 170 } 171 } 172 173 # gateways/versioned sets require dealing with output data slightly 174 # differently, so check for those here 175 debug("Begin set-type check"); 176 my $existVersions = 0; 177 my @gwSets = (); 178 my @nonGWsets = (); 179 my %gwSetNames = (); # this is necessary because we get a setname 180 # for all versions of g/w tests 181 foreach ( @sets ) { 182 if ( defined( $_->assignment_type() ) && 183 $_->assignment_type() =~ /gateway/ ) { 184 $existVersions = 1; 185 186 push( @gwSets, $_ ) if ( ! defined($gwSetNames{$_->set_id}) ); 187 $gwSetNames{$_->set_id} = 1; 188 } else { 189 push( @nonGWsets, $_ ); 190 } 191 } 192 # now get all user set versions that we need 193 my @vSets = (); 194 # we need the template sets below, so also make an indexed list of those 195 my %gwSetsBySetID = (); 196 foreach my $set ( @gwSets ) { 197 $gwSetsBySetID{$set->set_id} = $set; 198 199 my @setVer = $db->listSetVersions( $effectiveUser, $set->set_id ); 200 my @setVerIDs = map { [ $effectiveUser, $set->set_id, $_ ] } @setVer; 201 push( @vSets, $db->getMergedSetVersions( @setVerIDs ) ); 202 } 203 204 # set sort method 205 $sort = "status" unless $sort eq "status" or $sort eq "name"; 206 207 # now set the headers for the table 208 my $nameHeader = $sort eq "name" 209 ? CGI::u("Name") 210 : CGI::a({href=>$self->systemLink($urlpath, params=>{sort=>"name"})}, "Name"); 211 my $statusHeader = $sort eq "status" 212 ? CGI::u("Status") 213 : CGI::a({href=>$self->systemLink($urlpath, params=>{sort=>"status"})}, "Status"); 214 # print the start of the form 215 216 print CGI::start_form(-method=>"POST",-action=>$actionURL), 217 $self->hidden_authen_fields; 218 219 # and send the start of the table 220 print CGI::start_table(); 221 if ( ! $existVersions ) { 222 print CGI::Tr({}, 223 CGI::th("Sel."), 224 CGI::th($nameHeader), 225 CGI::th($statusHeader), 226 ); 227 } else { 228 print CGI::Tr( 229 CGI::th("Sel."), 230 CGI::th($nameHeader), 231 CGI::th("TestScore"), 232 CGI::th("TestDate"), 233 CGI::th($statusHeader), 234 ); 235 } 236 237 debug("Begin sorting merged sets"); 238 239 # before building final set lists, exclude proctored gateway sets 240 # for users without permission to view them 241 my $viewPr = $authz->hasPermissions( $user, "view_proctored_tests" ); 242 @gwSets = grep {$_->assignment_type !~ /proctored/ || $viewPr} @gwSets; 243 244 if ( $sort eq 'name' ) { 245 @nonGWsets = sortByName("set_id", @nonGWsets); 246 @gwSets = sortByName("set_id", @gwSets); 247 } elsif ( $sort eq 'status' ) { 248 @nonGWsets = sort byUrgency @nonGWsets; 249 @gwSets = sort byUrgency @gwSets; 250 } 251 # we sort set versions by name 252 @vSets = sortByName(["set_id", "version_id"], @vSets); 253 254 # put together a complete list of sorted sets to consider 255 @sets = (@nonGWsets, @gwSets ); 256 257 debug("End preparing merged sets"); 258 259 # we do regular sets and the gateway set templates separately 260 # from the actual set-versions, to avoid managing a tricky test 261 # for a version number that may not exist 262 foreach my $set (@sets) { 263 die "set $set not defined" unless $set; 264 265 if ($set->published || $authz->hasPermissions($user, "view_unpublished_sets")) { 266 print $self->setListRow($set, $authz->hasPermissions($user, "view_multiple_sets"), $authz->hasPermissions($user, "view_unopened_sets"),$existVersions,$db); 267 } 268 } 269 foreach my $set (@vSets) { 270 die "set $set not defined" unless $set; 271 272 if ($set->published || $authz->hasPermissions($user, "view_unpublished_sets")) { 273 print $self->setListRow($set, $authz->hasPermissions($user, "view_multiple_sets"), $authz->hasPermissions($user, "view_unopened_sets"),$existVersions,$db,1, $gwSetsBySetID{$set->{set_id}} ); # 1 = gateway, versioned set 274 } 275 } 276 277 print CGI::end_table(); 278 my $pl = ($authz->hasPermissions($user, "view_multiple_sets") ? "s" : ""); 279 print CGI::p(CGI::submit(-name=>"hardcopy", -label=>"Download Hardcopy for Selected Set$pl")); 280 print CGI::endform(); 281 282 ## feedback form url 283 #my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", courseID => $courseName); 284 #my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action 285 # 286 ##print feedback form 287 #print 288 # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 289 # $self->hidden_authen_fields,"\n", 290 # CGI::hidden("module", __PACKAGE__),"\n", 291 # CGI::hidden("set", ''),"\n", 292 # CGI::hidden("problem", ''),"\n", 293 # CGI::hidden("displayMode", ''),"\n", 294 # CGI::hidden("showOldAnswers", ''),"\n", 295 # CGI::hidden("showCorrectAnswers", ''),"\n", 296 # CGI::hidden("showHints", ''),"\n", 297 # CGI::hidden("showSolutions", ''),"\n", 298 # CGI::p({-align=>"left"}, 299 # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 300 # ), 301 # CGI::endform(),"\n"; 302 303 print $self->feedbackMacro( 304 module => __PACKAGE__, 305 set => "", 306 problem => "", 307 displayMode => "", 308 showOldAnswers => "", 309 showCorrectAnswers => "", 310 showHints => "", 311 showSolutions => "", 312 ); 313 314 return ""; 315 } 316 317 sub setListRow { 318 my ($self, $set, $multiSet, $preOpenSets, $existVersions, $db, 319 $gwtype, $tmplSet) = @_; 320 my $r = $self->r; 321 my $ce = $r->ce; 322 my $authz = $r->authz; 323 my $user = $r->param("user"); 324 my $urlpath = $r->urlpath; 325 $gwtype = 0 if ( ! defined( $gwtype ) ); 326 $tmplSet = $set if ( ! defined( $tmplSet ) ); 327 328 my $name = $set->set_id; 329 my $urlname = ( $gwtype == 1 ) ? "$name,v" . $set->version_id : $name; 330 331 my $courseName = $urlpath->arg("courseID"); 332 333 my $problemSetPage; 334 335 if ( ! defined( $set->assignment_type() ) || 336 $set->assignment_type() !~ /gateway/ ) { 337 $problemSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet", 338 courseID => $courseName, setID => $urlname); 339 } elsif( $set->assignment_type() !~ /proctored/ ) { 340 341 $problemSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::GatewayQuiz", 342 courseID => $courseName, setID => $urlname); 343 } else { 344 345 $problemSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::GatewayQuiz", 346 courseID => $courseName, setID => $urlname); 347 } 348 349 my $interactiveURL = $self->systemLink($problemSetPage, 350 params=>{ displayMode => $self->{displayMode}, 351 showOldAnswers => $self->{will}->{showOldAnswers} 352 } 353 ); 354 355 # check to see if this is a template gateway assignment 356 $gwtype = 2 if ( defined( $set->assignment_type() ) && 357 $set->assignment_type() =~ /gateway/ && ! $gwtype ); 358 # and get problemRecords if we're dealing with a versioned set, so that 359 # we can test status and scores 360 # FIXME: should we really have to get the merged 361 # problem_versions here? it looks that way, because 362 # otherwise we don't inherit things like the problem 363 # value properly. 364 my @problemRecords = 365 $db->getAllProblemVersions($set->user_id(), $set->set_id(), 366 $set->version_id()) 367 if ( $gwtype == 1 ); 368 369 # the conditional here should be redundant. ah well. 370 $interactiveURL =~ s|/quiz_mode/|/proctored_quiz_mode/| if 371 ( defined( $set->assignment_type() ) && 372 $set->assignment_type() eq 'proctored_gateway' ); 373 374 my $control = ""; 375 if ($multiSet) { 376 if ( $gwtype < 2 ) { 377 $control = CGI::checkbox( 378 -name=>"selected_sets", 379 -value=>$name . ($gwtype ? ",v" . $set->version_id : ''), 380 -label=>"", 381 ); 382 } else { 383 $control = ' '; 384 } 385 } else { 386 if ( $gwtype < 2 ) { 387 my $n = $name . ($gwtype ? ",v" . $set->version_id : ''); 388 $control = CGI::radio_group( 389 -name=>"selected_sets", 390 -values=>[$n], 391 -default=>"-", 392 -labels=>{$n => ""}, 393 ); 394 } else { 395 $control = ' '; 396 } 397 } 398 399 $name =~ s/_/ /g; 400 # this is the link to the homework assignment 401 my $interactive = CGI::a({-href=>$interactiveURL}, "$name"); 402 403 # we choose not to display the link to start a new gateway that we've just 404 # set up in the previous line if that's not available, so we work out here 405 # if the set is open. for gateways this is a bit more complicated than 406 # for homework sets 407 my $setIsOpen = 0; 408 my $status = ''; 409 if ( $gwtype ) { 410 if ( $gwtype == 1 ) { 411 if ( $problemRecords[0]->num_correct() + 412 $problemRecords[0]->num_incorrect() >= 413 $set->attempts_per_version() ) { 414 $status = "completed."; 415 } elsif ( time() > $set->due_date() + 416 $self->r->ce->{gatewayGracePeriod} ) { 417 $status = "over time: closed."; 418 } else { 419 $status = "open: complete by " . 420 $self->formatDateTime($set->due_date()); 421 } 422 # we let people go back to old tests 423 $setIsOpen = 1; 424 425 # reset the link to give the test number 426 my $vnum = $set->version_id; 427 $interactive = CGI::a({-href=>$interactiveURL}, 428 "$name (test$vnum)"); 429 } else { 430 my $t = time(); 431 if ( $t < $set->open_date() ) { 432 $status = "will open on " . $self->formatDateTime($set->open_date); 433 if ( $preOpenSets ) { 434 # reset the link 435 $interactive = CGI::a({-href=>$interactiveURL}, 436 "Take $name test"); 437 } else { 438 $control = ""; 439 $interactive = "$name test"; 440 } 441 } elsif ( $t < $set->due_date() ) { 442 $status = "now open, due " . $self->formatDateTime($set->due_date); 443 $setIsOpen = 1; 444 $interactive = CGI::a({-href=>$interactiveURL}, 445 "Take $name test"); 446 } else { 447 $status = "closed"; 448 449 if ( $authz->hasPermissions( $user, "record_answers_after_due_date" ) ) { 450 $interactive = CGI::a({-href=>$interactiveURL}, 451 "Take $name test"); 452 } else { 453 $interactive = "$name test"; 454 } 455 } 456 } 457 458 # old conditional 459 } elsif (time < $set->open_date) { 460 $status = "will open on " . $self->formatDateTime($set->open_date); 461 $control = "" unless $preOpenSets; 462 $interactive = $name unless $preOpenSets; 463 } elsif (time < $set->due_date) { 464 $status = "now open, due " . $self->formatDateTime($set->due_date); 465 my $enable_reduced_scoring = $set->enable_reduced_scoring; 466 my $reducedScoringPeriod = $ce->{pg}->{ansEvalDefaults}->{reducedScoringPeriod}; 467 if ($reducedScoringPeriod > 0 and $enable_reduced_scoring ) { 468 my $reducedScoringPeriodSec = $reducedScoringPeriod*60; # $reducedScoringPeriod is in minutes 469 my $beginReducedScoringPeriod = $self->formatDateTime($set->due_date() - $reducedScoringPeriodSec); 470 # $status .= '. <FONT COLOR="#cc6600">Reduced Credit starts ' . $beginReducedScoringPeriod . '</FONT>'; 471 $status .= '. <div class="ResultsAlert">Reduced Credit starts ' . $beginReducedScoringPeriod . '</div>'; 472 473 } 474 $setIsOpen = 1; 475 } elsif (time < $set->answer_date) { 476 $status = "closed, answers on " . $self->formatDateTime($set->answer_date); 477 } elsif ($set->answer_date <= time and time < $set->answer_date +RECENT ) { 478 $status = "closed, answers recently available"; 479 } else { 480 $status = "closed, answers available"; 481 } 482 483 my $publishedClass = ($set->published) ? "Published" : "Unpublished"; 484 485 $status = CGI::font({class=>$publishedClass}, $status) if $preOpenSets; 486 487 # check to see if we need to return a score and a date column 488 if ( ! $existVersions ) { 489 return CGI::Tr(CGI::td([ 490 $control, 491 $interactive, 492 $status, 493 ])); 494 } else { 495 my ( $startTime, $score ); 496 497 if ( defined( $set->assignment_type() ) && 498 $set->assignment_type() =~ /gateway/ && $gwtype == 1 ) { 499 $startTime = localtime($set->version_creation_time()); 500 501 if ( $authz->hasPermissions($user, "view_hidden_work") || 502 $set->hide_score_by_problem eq 'Y' || 503 $set->hide_score() eq 'N' || 504 ( $set->hide_score eq 'BeforeAnswerDate' && time > $tmplSet->answer_date() ) ) { 505 # find score 506 507 # DBFIXME we can do this math in the database, i think 508 my $possible = 0; 509 $score = 0; 510 foreach my $pRec ( @problemRecords ) { 511 my $pval = $pRec->value() ? $pRec->value() : 1; 512 if ( defined( $pRec ) && 513 $score ne 'undef' ) { 514 $score += $pRec->status()*$pval || 0; 515 } else { 516 $score = 'undef'; 517 } 518 $possible += $pval; 519 } 520 $score = "$score/$possible"; 521 } else { 522 $score = "n/a"; 523 } 524 } else { 525 $startTime = ' '; 526 $score = $startTime; 527 } 528 return CGI::Tr(CGI::td([ 529 $control, 530 $interactive, 531 $score, 532 $startTime, 533 $status, 534 ])); 535 } 536 } 537 538 sub byname { $a->set_id cmp $b->set_id; } 539 540 sub byUrgency { 541 my $mytime = time; 542 my @a_parts = ($a->answer_date + RECENT <= $mytime) ? (4, $a->open_date, $a->due_date, $a->set_id) 543 : ($a->answer_date <= $mytime and $mytime < $a->answer_date + RECENT) ? (3, $a-> answer_date, $a-> due_date, $a->set_id) 544 : ($a->due_date <= $mytime and $mytime < $a->answer_date ) ? (2, $a->answer_date, $a->due_date, $a->set_id) 545 : ($mytime < $a->open_date) ? (1, $a->open_date, $a->due_date, $a->set_id) 546 : (0, $a->due_date, $a->open_date, $a->set_id); 547 my @b_parts = ($b->answer_date + RECENT <= $mytime) ? (4, $b->open_date, $b->due_date, $b->set_id) 548 : ($b->answer_date <= $mytime and $mytime < $b->answer_date + RECENT) ? (3, $b-> answer_date, $b-> due_date, $b->set_id) 549 : ($b->due_date <= $mytime and $mytime < $b->answer_date ) ? (2, $b->answer_date, $b->due_date, $b->set_id) 550 : ($mytime < $b->open_date) ? (1, $b->open_date, $b->due_date, $b->set_id) 551 : (0, $b->due_date, $b->open_date, $b->set_id); 552 my $returnIt=0; 553 while (scalar(@a_parts) > 1) { 554 if ($returnIt = ( (shift @a_parts) <=> (shift @b_parts) ) ) { 555 return($returnIt); 556 } 557 } 558 return ( $a_parts[0] cmp $b_parts[0] ); 559 } 560 561 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |