Parent Directory
| 
Revision Log
GatewayQuiz preliminary commit adding multi-page test capability. This requires updating the database to add the problems_per_page record to the set tables of the database.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # 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::Instructor::ProblemSetDetail; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::ProblemSetDetail - Edit general set and specific user/set information as well as problem information 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI qw(-nosticky ); 29 use WeBWorK::CGI; 30 use WeBWorK::HTML::ComboBox qw/comboBox/; 31 use WeBWorK::Utils qw(readDirectory list2hash listFilesRecursive max); 32 use WeBWorK::DB::Record::Set; 33 use WeBWorK::Utils::Tasks qw(renderProblems); 34 use WeBWorK::Debug; 35 36 # Important Note: the following two sets of constants may seem similar 37 # but they are functionally and semantically different 38 39 # these constants determine which fields belong to what type of record 40 use constant SET_FIELDS => [qw(set_header hardcopy_header open_date due_date answer_date published assignment_type attempts_per_version version_time_limit versions_per_interval time_interval problem_randorder problems_per_page)]; 41 use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts)]; 42 use constant USER_PROBLEM_FIELDS => [qw(problem_seed status num_correct num_incorrect)]; 43 44 # these constants determine what order those fields should be displayed in 45 use constant HEADER_ORDER => [qw(set_header hardcopy_header)]; 46 use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts attempted last_answer num_correct num_incorrect)]; 47 48 # we exclude the gateway set fields from the set field order, because they 49 # are only displayed for sets that are gateways. this results in a bit of 50 # convoluted logic below, but it saves burdening people who are only using 51 # homework assignments with all of the gateway parameters 52 use constant SET_FIELD_ORDER => [qw(open_date due_date answer_date published assignment_type)]; 53 use constant GATEWAY_SET_FIELD_ORDER => [qw(attempts_per_version version_time_limit time_interval versions_per_interval problem_randorder problems_per_page)]; 54 55 # this constant is massive hash of information corresponding to each db field. 56 # override indicates for how many students at a time a field can be overridden 57 # this hash should make it possible to NEVER have explicitly: if (somefield) { blah() } 58 # 59 # All but name are optional 60 # some_field => { 61 # name => "Some Field", 62 # type => "edit", # edit, choose, hidden, view - defines how the data is displayed 63 # size => "50", # size of the edit box (if any) 64 # override => "none", # none, one, any, all - defines for whom this data can/must be overidden 65 # module => "problem_list", # WeBWorK module 66 # default => 0 # if a field cannot default to undefined/empty what should it default to 67 # labels => { # special values can be hashed to display labels 68 # 1 => "Yes", 69 # 0 => "No", 70 # }, 71 72 use constant BLANKPROBLEM => 'blankProblem.pg'; 73 74 use constant FIELD_PROPERTIES => { 75 # Set information 76 set_header => { 77 name => "Set Header", 78 type => "edit", 79 size => "50", 80 override => "all", 81 module => "problem_list", 82 default => "", 83 }, 84 hardcopy_header => { 85 name => "Hardcopy Header", 86 type => "edit", 87 size => "50", 88 override => "all", 89 module => "hardcopy_preselect_set", 90 default => "", 91 }, 92 open_date => { 93 name => "Opens", 94 type => "edit", 95 size => "26", 96 override => "any", 97 labels => { 98 #0 => "None Specified", 99 "" => "None Specified", 100 }, 101 }, 102 due_date => { 103 name => "Answers Due", 104 type => "edit", 105 size => "26", 106 override => "any", 107 labels => { 108 #0 => "None Specified", 109 "" => "None Specified", 110 }, 111 }, 112 answer_date => { 113 name => "Answers Available", 114 type => "edit", 115 size => "26", 116 override => "any", 117 labels => { 118 #0 => "None Specified", 119 "" => "None Specified", 120 }, 121 }, 122 published => { 123 name => "Visible to Students", 124 type => "choose", 125 override => "all", 126 choices => [qw( 0 1 )], 127 labels => { 128 1 => "Yes", 129 0 => "No", 130 }, 131 }, 132 assignment_type => { 133 name => "Assignment type", 134 type => "choose", 135 override => "all", 136 choices => [qw( default gateway proctored_gateway )], 137 labels => { default => "homework", 138 gateway => "gateway/quiz", 139 proctored_gateway => "proctored gateway/quiz", 140 }, 141 }, 142 attempts_per_version => { 143 name => "Attempts per Version (untested for > 1)", 144 type => "edit", 145 size => "3", 146 override => "all", 147 # labels => { "" => 1 }, 148 }, 149 version_time_limit => { 150 name => "Test Time Limit (sec)", 151 type => "edit", 152 size => "4", 153 override => "any", 154 labels => { "" => 0 }, # I'm not sure this is quite right 155 }, 156 time_interval => { 157 name => "Time Interval for New Versions (sec)", 158 type => "edit", 159 size => "5", 160 override => "all", 161 labels => { "" => 0 }, 162 }, 163 versions_per_interval => { 164 name => "Number of New Versions per Time Interval (0=infty)", 165 type => "edit", 166 size => "3", 167 override => "all", 168 labels => { "" => 0 }, 169 # labels => { "" => 1 }, 170 }, 171 problem_randorder => { 172 name => "Order Problems Randomly", 173 type => "choose", 174 choices => [qw( 0 1 )], 175 override => "all", 176 labels => { 0 => "No", 1 => "Yes" }, 177 }, 178 problems_per_page => { 179 name => "Number of Problems per Page (0=all)", 180 type => "edit", 181 size => "3", 182 override => "all", 183 labels => { "" => 0 }, 184 }, 185 # Problem information 186 source_file => { 187 name => "Source File", 188 type => "edit", 189 size => 50, 190 override => "any", 191 default => "", 192 }, 193 value => { 194 name => "Weight", 195 type => "edit", 196 size => 6, 197 override => "any", 198 }, 199 max_attempts => { 200 name => "Max attempts", 201 type => "edit", 202 size => 6, 203 override => "any", 204 labels => { 205 "-1" => "unlimited", 206 }, 207 }, 208 problem_seed => { 209 name => "Seed", 210 type => "edit", 211 size => 6, 212 override => "one", 213 214 }, 215 status => { 216 name => "Status", 217 type => "edit", 218 size => 6, 219 override => "one", 220 default => 0, 221 }, 222 attempted => { 223 name => "Attempted", 224 type => "hidden", 225 override => "none", 226 choices => [qw( 0 1 )], 227 labels => { 228 1 => "Yes", 229 0 => "No", 230 }, 231 default => 0, 232 }, 233 last_answer => { 234 name => "Last Answer", 235 type => "hidden", 236 override => "none", 237 }, 238 num_correct => { 239 name => "Correct", 240 type => "hidden", 241 override => "none", 242 default => 0, 243 }, 244 num_incorrect => { 245 name => "Incorrect", 246 type => "hidden", 247 override => "none", 248 default => 0, 249 }, 250 }; 251 252 # Create a table of fields for the given parameters, one row for each db field 253 # if only the setID is included, it creates a table of set information 254 # if the problemID is included, it creates a table of problem information 255 sub FieldTable { 256 my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord) = @_; 257 258 my $r = $self->r; 259 my @editForUser = $r->param('editForUser'); 260 my $forUsers = scalar(@editForUser); 261 my $forOneUser = $forUsers == 1; 262 263 my @fieldOrder; 264 my $gwoutput = ''; 265 if (defined $problemID) { 266 @fieldOrder = @{ PROBLEM_FIELD_ORDER() }; 267 } else { 268 @fieldOrder = @{ SET_FIELD_ORDER() }; 269 270 # gateway data fields are included only if the set is a gateway 271 if ( $globalRecord->assignment_type() =~ /gateway/ ) { 272 my $gwhdr = "\n<!-- begin gwoutput table -->\n"; 273 my $nF = 0; 274 275 foreach my $gwfield ( @{ GATEWAY_SET_FIELD_ORDER() } ) { 276 my @fieldData = 277 ($self->FieldHTML($userID, $setID, $problemID, 278 $globalRecord, $userRecord, 279 $gwfield)); 280 if ( @fieldData && defined($fieldData[1]) and $fieldData[1] ne '' ) { 281 $nF = @fieldData if ( @fieldData > $nF ); 282 $gwoutput .= CGI::Tr({}, CGI::td({}, [@fieldData])); 283 } 284 } 285 $gwhdr .= CGI::Tr({},CGI::td({colspan=>$nF}, 286 CGI::em("Gateway parameters"))) 287 if ( $nF ); 288 $gwoutput = "$gwhdr$gwoutput\n" . 289 "<!-- end gwoutput table -->\n"; 290 } 291 } 292 293 my $output = CGI::start_table({border => 0, cellpadding => 1}); 294 if ($forUsers) { 295 $output .= CGI::Tr({}, 296 CGI::th({colspan=>"2"}, " "), 297 CGI::th({colspan=>"1"}, "User Values"), 298 CGI::th({}, "Class values"), 299 ); 300 } 301 302 foreach my $field (@fieldOrder) { 303 my %properties = %{ FIELD_PROPERTIES()->{$field} }; 304 unless ($properties{type} eq "hidden") { 305 $output .= CGI::Tr({}, CGI::td({}, [$self->FieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field)])) . "\n"; 306 } 307 # this is a rather artifical addition to include gateway fields, which we 308 # only want to show for gateways 309 $output .= "$gwoutput\n" 310 if ( $field eq 'assignment_type' && 311 $globalRecord->assignment_type() =~ /gateway/ ); 312 } 313 314 if (defined $problemID) { 315 #my $problemRecord = $r->{db}->getUserProblem($userID, $setID, $problemID); 316 my $problemRecord = $userRecord; # we get this from the caller, hopefully 317 $output .= CGI::Tr({}, CGI::td({}, ["","Attempts", ($problemRecord->num_correct || 0) + ($problemRecord->num_incorrect || 0)])) if $forOneUser; 318 } 319 $output .= CGI::end_table(); 320 321 return $output; 322 } 323 324 # Returns a list of information and HTML widgets 325 # for viewing and editing the specified db fields 326 # if only the setID is included, it creates a list of set information 327 # if the problemID is included, it creates a list of problem information 328 sub FieldHTML { 329 my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $field) = @_; 330 331 my $r = $self->r; 332 my $db = $r->db; 333 my @editForUser = $r->param('editForUser'); 334 my $forUsers = scalar(@editForUser); 335 my $forOneUser = $forUsers == 1; 336 337 #my ($globalRecord, $userRecord, $mergedRecord); 338 #if (defined $problemID) { 339 # $globalRecord = $db->getGlobalProblem($setID, $problemID); 340 # $userRecord = $db->getUserProblem($userID, $setID, $problemID); 341 # #$mergedRecord = $db->getMergedProblem($userID, $setID, $problemID); # never used --sam 342 #} else { 343 # $globalRecord = $db->getGlobalSet($setID); 344 # $userRecord = $db->getUserSet($userID, $setID); 345 # #$mergedRecord = $db->getMergedSet($userID, $setID); # never user --sam 346 #} 347 348 return "No data exists for set $setID and problem $problemID" unless $globalRecord; 349 return "No user specific data exists for user $userID" if $forOneUser and $globalRecord and not $userRecord; 350 351 my %properties = %{ FIELD_PROPERTIES()->{$field} }; 352 my %labels = %{ $properties{labels} }; 353 return "" if $properties{type} eq "hidden"; 354 return "" if $properties{override} eq "one" && not $forOneUser; 355 return "" if $properties{override} eq "none" && not $forOneUser; 356 return "" if $properties{override} eq "all" && $forUsers; 357 358 my $edit = ($properties{type} eq "edit") && ($properties{override} ne "none"); 359 my $choose = ($properties{type} eq "choose") && ($properties{override} ne "none"); 360 361 my $globalValue = $globalRecord->{$field}; 362 # use defined instead of value in order to allow 0 to printed, e.g. for the 'value' field 363 $globalValue = (defined($globalValue)) ? ($labels{$globalValue || ""} || $globalValue) : ""; 364 my $userValue = $userRecord->{$field}; 365 $userValue = (defined($userValue)) ? ($labels{$userValue || ""} || $userValue) : ""; 366 367 if ($field =~ /_date/) { 368 $globalValue = $self->formatDateTime($globalValue) if defined $globalValue && $globalValue ne $labels{""}; 369 $userValue = $self->formatDateTime($userValue) if defined $userValue && $userValue ne $labels{""}; 370 } 371 372 # check to make sure that a given value can be overridden 373 my %canOverride = map { $_ => 1 } (@{ PROBLEM_FIELDS() }, @{ SET_FIELDS() }); 374 my $check = $canOverride{$field}; 375 376 # $recordType is a shorthand in the return statement for problem or set 377 # $recordID is a shorthand in the return statement for $problemID or $setID 378 my $recordType = ""; 379 my $recordID = ""; 380 if (defined $problemID) { 381 $recordType = "problem"; 382 $recordID = $problemID; 383 } else { 384 $recordType = "set"; 385 $recordID = $setID; 386 } 387 388 # $inputType contains either an input box or a popup_menu for changing a given db field 389 my $inputType = ""; 390 if ($edit) { 391 $inputType = CGI::input({ 392 name => "$recordType.$recordID.$field", 393 value => $r->param("$recordType.$recordID.$field") || ($forUsers ? $userValue : $globalValue), 394 size => $properties{size} || 5, 395 }); 396 } elsif ($choose) { 397 # Note that in popup menus, you're almost guaranteed to have the choices hashed to labels in %properties 398 # but $userValue and and $globalValue are the values in the hash not the keys 399 # so we have to use the actual db record field values to select our default here. 400 $inputType = CGI::popup_menu({ 401 name => "$recordType.$recordID.$field", 402 values => $properties{choices}, 403 labels => \%labels, 404 default => $r->param("$recordType.$recordID.$field") || ($forUsers ? $userRecord->$field : $globalRecord->$field), 405 }); 406 } 407 408 return (($forUsers && $edit && $check) ? CGI::checkbox({ 409 type => "checkbox", 410 name => "$recordType.$recordID.$field.override", 411 label => "", 412 value => $field, 413 checked => $r->param("$recordType.$recordID.$field.override") || ($userValue ne ($labels{""} || "") ? 1 : 0), 414 }) : "", 415 $properties{name}, 416 $inputType, 417 $forUsers ? " $globalValue" : "", 418 ); 419 } 420 421 # creates a popup menu of all possible problem numbers (for possible rearranging) 422 sub problem_number_popup { 423 my $num = shift; 424 my $total = shift; 425 return (CGI::popup_menu(-name => "problem_num_$num", 426 -values => [1..$total], 427 -default => $num)); 428 } 429 430 # handles rearrangement necessary after changes to problem ordering 431 sub handle_problem_numbers { 432 my $newProblemNumbersref = shift; 433 my %newProblemNumbers = %$newProblemNumbersref; 434 my $maxNum = shift; 435 my $db = shift; 436 my $setID = shift; 437 my $force = shift || 0; 438 my @sortme=(); 439 my ($j, $val); 440 441 # keys are current problem numbers, values are target problem numbers 442 foreach $j (keys %newProblemNumbers) { 443 # we don't want to act unless all problems have been assigned a new problem number, so if any have not, return 444 return "" if (not defined $newProblemNumbers{"$j"}); 445 # if the problem has been given a new number, we reduce the "score" of the problem by the original number of the problem 446 # when multiple problems are assigned the same number, this results in the last one ending up first -- FIXME? 447 if ($newProblemNumbers{"$j"} != $j) { 448 # force always gets set if reordering is done, so don't expect to be able to delete a problem, 449 # reorder some other problems, and end up with a hole -- FIXME 450 $force = 1; 451 $val = 1000 * $newProblemNumbers{$j} - $j; 452 } else { 453 $val = 1000 * $newProblemNumbers{$j}; 454 } 455 # store a mapping between current problem number and score (based on currnet and new problem number) 456 push @sortme, [$j, $val]; 457 # replace new problem numbers in hash with the (global) problems themselves 458 $newProblemNumbers{$j} = $db->getGlobalProblem($setID, $j); 459 die "global $j for set $setID not found." unless $newProblemNumbers{$j}; 460 } 461 462 # we don't have to do anything if we're not getting rid of holes 463 return "" unless $force; 464 465 # sort the curr. prob. num./score pairs by score 466 @sortme = sort {$a->[1] <=> $b->[1]} @sortme; 467 # now, for global and each user with this set, loop through problem list 468 # get all of the problem records 469 # assign new problem numbers 470 # loop - if number is new, put the problem record 471 # print "Sorted to get ". join(', ', map {$_->[0] } @sortme) ."<p>\n"; 472 473 474 # Now, three stages. First global values 475 476 for ($j = 0; $j < scalar @sortme; $j++) { 477 if($sortme[$j][0] == $j + 1) { 478 # if the jth problem (according to the new ordering) is in the right place (problem IDs are numbered from 1, hence $j+1) 479 # do nothing 480 } elsif (not defined $newProblemNumbers{$j + 1}) { 481 # otherwise, if there's a hole for it, add it there 482 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 483 $db->addGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 484 } else { 485 # otherwise, overwrite the data for the problem that's already there with the jth problem's data (with a changed problemID) 486 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 487 $db->putGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 488 } 489 } 490 491 my @setUsers = $db->listSetUsers($setID); 492 my (@problist, $user); 493 my $globalUserID = $db->{set}->{params}->{globalUserID} || ''; 494 495 foreach $user (@setUsers) { 496 # if this is gdbm, the global user has been taken care of above. 497 # we can't do it again. This relies on the global user not having 498 # a blank name. 499 next if $globalUserID eq $user; 500 # grab a copy of each UserProblem for this user. @problist can be sparse (if problems were deleted) 501 for $j (keys %newProblemNumbers) { 502 $problist[$j] = $db->getUserProblem($user, $setID, $j); 503 } 504 use Data::Dumper; 505 for($j = 0; $j < scalar @sortme; $j++) { 506 if ($sortme[$j][0] == $j + 1) { 507 # same as above -- the jth problem is in the right place, so don't worry about it 508 # do nothing 509 } elsif ($problist[$sortme[$j][0]]) { 510 # we've made sure the user's problem actually exists HERE, since we want to be able to fail gracefullly if it doesn't 511 # the problem with the original conditional below is that %newProblemNumbers maps oldids => global problem record 512 # we need to check if the target USER PROBLEM exists, which is what @problist knows 513 #if (not defined $newProblemNumbers{$j + 1}) { 514 if (not defined $problist[$j+1]) { 515 # same as above -- there's a hole for that problem to go into, so add it in its new place 516 $problist[$sortme[$j][0]]->problem_id($j + 1); 517 $db->addUserProblem($problist[$sortme[$j][0]]); 518 } else { 519 # same as above -- there's a problem already there, so overwrite its data with the data from the jth problem 520 $problist[$sortme[$j][0]]->problem_id($j + 1); 521 $db->putUserProblem($problist[$sortme[$j][0]]); 522 } 523 } else { 524 warn "UserProblem missing for user=$user set=$setID problem=$sortme[$j][0]. This may indicate database corruption.\n"; 525 # when a problem doesn't exist in the target slot, a new problem gets added there, but the original problem 526 # never gets overwritten (because there wan't a problem it would have to get exchanged with) 527 # i think this can get pretty complex. consider 1=>2, 2=>3, 3=>4, 4=>1 where problem 1 doesn't exist for some user: 528 # @sortme[$j][0] will contain: 4, 1, 2, 3 529 # - problem 1 will get **added** with the data from problem 4 (because problem 1 doesn't exist for this user) 530 # - problem 2 will get overwritten with the data from problem 1 531 # - problem 3 will get overwritten with the data from problem 2 532 # - nothing will happend to problem 4, since problem 1 doesn't exit 533 # so the solution is to delete problem 4 altogether! 534 # here's the fix: 535 536 # the data from problem $j+1 was/will be moved to another problem slot, 537 # but there's no problem $sortme[$j][0] to replace it. thus, we delete it now. 538 $db->deleteUserProblem($user, $setID, $j+1); 539 } 540 } 541 } 542 543 # any problems with IDs above $maxNum get deleted -- presumably their data has been copied into problems with lower IDs 544 foreach ($j = scalar @sortme; $j < $maxNum; $j++) { 545 if (defined $newProblemNumbers{$j + 1}) { 546 $db->deleteGlobalProblem($setID, $j+1); 547 } 548 } 549 550 # return a string form of the old problem IDs in the new order (not used by caller, incidentally) 551 return join(', ', map {$_->[0]} @sortme); 552 } 553 554 # swap index given with next bigger index 555 # leftover from when we had up/down buttons 556 # maybe we will bring them back 557 558 #sub moveme { 559 # my $index = shift; 560 # my $db = shift; 561 # my $setID = shift; 562 # my (@problemIDList) = @_; 563 # my ($prob1, $prob2, $prob); 564 # 565 # foreach my $problemID (@problemIDList) { 566 # my $problemRecord = $db->getGlobalProblem($setID, $problemID); # checked 567 # die "global $problemID for set $setID not found." unless $problemRecord; 568 # if ($problemRecord->problem_id == $index) { 569 # $prob1 = $problemRecord; 570 # } elsif ($problemRecord->problem_id == $index + 1) { 571 # $prob2 = $problemRecord; 572 # } 573 # } 574 # if (not defined $prob1 or not defined $prob2) { 575 # die "cannot find problem $index or " . ($index + 1); 576 # } 577 # 578 # $prob1->problem_id($index + 1); 579 # $prob2->problem_id($index); 580 # $db->putGlobalProblem($prob1); 581 # $db->putGlobalProblem($prob2); 582 # 583 # my @setUsers = $db->listSetUsers($setID); 584 # 585 # my $user; 586 # foreach $user (@setUsers) { 587 # $prob1 = $db->getUserProblem($user, $setID, $index); #checked 588 # die " problem $index for set $setID and effective user $user not found" 589 # unless $prob1; 590 # $prob2 = $db->getUserProblem($user, $setID, $index+1); #checked 591 # die " problem $index for set $setID and effective user $user not found" 592 # unless $prob2; 593 # $prob1->problem_id($index+1); 594 # $prob2->problem_id($index); 595 # $db->putUserProblem($prob1); 596 # $db->putUserProblem($prob2); 597 # } 598 #} 599 600 # primarily saves any changes into the correct set or problem records (global vs user) 601 # also deals with deleting or rearranging problems 602 sub initialize { 603 my ($self) = @_; 604 my $r = $self->r; 605 my $db = $r->db; 606 my $ce = $r->ce; 607 my $authz = $r->authz; 608 my $user = $r->param('user'); 609 my $setID = $r->urlpath->arg("setID"); 610 my $setRecord = $db->getGlobalSet($setID); # checked 611 die "global set $setID not found." unless $setRecord; 612 613 $self->{set} = $setRecord; 614 my @editForUser = $r->param('editForUser'); 615 # some useful booleans 616 my $forUsers = scalar(@editForUser); 617 my $forOneUser = $forUsers == 1; 618 619 # Check permissions 620 return unless ($authz->hasPermissions($user, "access_instructor_tools")); 621 return unless ($authz->hasPermissions($user, "modify_problem_sets")); 622 623 624 my %properties = %{ FIELD_PROPERTIES() }; 625 626 # takes a hash of hashes and inverts it 627 my %undoLabels; 628 foreach my $key (keys %properties) { 629 %{ $undoLabels{$key} } = map { $properties{$key}->{labels}->{$_} => $_ } keys %{ $properties{$key}->{labels} }; 630 } 631 632 # Unfortunately not everyone uses Javascript enabled browsers so 633 # we must fudge the information coming from the ComboBoxes 634 # Since the textfield and menu both have the same name, we get an array of two elements 635 # We then reset the param to the first if its not-empty or the second (empty or not). 636 foreach ( @{ HEADER_ORDER() } ) { 637 my @values = $r->param("set.$setID.$_"); 638 my $value = $values[0] || $values[1] || ""; 639 $r->param("set.$setID.$_", $value); 640 } 641 642 ##################################################################### 643 # Check date information 644 ##################################################################### 645 646 my ($open_date, $due_date, $answer_date); 647 my $error = 0; 648 if (defined $r->param('submit_changes')) { 649 my @names = ("open_date", "due_date", "answer_date"); 650 651 my %dates = map { $_ => $r->param("set.$setID.$_") } @names; 652 %dates = map { 653 my $unlabel = $undoLabels{$_}->{$dates{$_}}; 654 $_ => defined $unlabel ? $setRecord->$_ : $self->parseDateTime($dates{$_}) 655 } @names; 656 657 ($open_date, $due_date, $answer_date) = map { $dates{$_} } @names; 658 659 if ($answer_date < $due_date || $answer_date < $open_date) { 660 $self->addbadmessage("Answers cannot be made available until on or after the due date!"); 661 $error = $r->param('submit_changes'); 662 } 663 664 if ($due_date < $open_date) { 665 $self->addbadmessage("Answers cannot be due until on or after the open date!"); 666 $error = $r->param('submit_changes'); 667 } 668 669 # make sure the dates are not more than 10 years in the future 670 my $curr_time = time; 671 my $seconds_per_year = 31_556_926; 672 my $cutoff = $curr_time + $seconds_per_year*10; 673 if ($open_date > $cutoff) { 674 $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); 675 $error = $r->param('submit_changes'); 676 } 677 if ($due_date > $cutoff) { 678 $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); 679 $error = $r->param('submit_changes'); 680 } 681 if ($answer_date > $cutoff) { 682 $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); 683 $error = $r->param('submit_changes'); 684 } 685 686 687 if ($error) { 688 $self->addbadmessage("No changes were saved!"); 689 } 690 } 691 692 if (defined $r->param('submit_changes') && !$error) { 693 694 #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam 695 696 ##################################################################### 697 # Save general set information (including headers) 698 ##################################################################### 699 700 if ($forUsers) { 701 my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser); 702 foreach my $record (@userRecords) { 703 foreach my $field ( @{ SET_FIELDS() } ) { 704 next unless canChange($forUsers, $field); 705 my $override = $r->param("set.$setID.$field.override"); 706 707 if (defined $override && $override eq $field) { 708 709 my $param = $r->param("set.$setID.$field"); 710 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 711 my $unlabel = $undoLabels{$field}->{$param}; 712 $param = $unlabel if defined $unlabel; 713 # $param = $undoLabels{$field}->{$param} || $param; 714 if ($field =~ /_date/) { 715 $param = $self->parseDateTime($param) unless defined $unlabel; 716 } 717 $record->$field($param); 718 } else { 719 $record->$field(undef); 720 } 721 722 } 723 $db->putUserSet($record); 724 } 725 } else { 726 foreach my $field ( @{ SET_FIELDS() } ) { 727 next unless canChange($forUsers, $field); 728 729 my $param = $r->param("set.$setID.$field"); 730 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 731 my $unlabel = $undoLabels{$field}->{$param}; 732 $param = $unlabel if defined $unlabel; 733 if ($field =~ /_date/) { 734 $param = $self->parseDateTime($param) unless defined $unlabel; 735 } 736 $setRecord->$field($param); 737 } 738 $db->putGlobalSet($setRecord); 739 } 740 741 ##################################################################### 742 # Save problem information 743 ##################################################################### 744 745 my @problemIDs = sort { $a <=> $b } $db->listGlobalProblems($setID);; 746 my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); 747 foreach my $problemRecord (@problemRecords) { 748 my $problemID = $problemRecord->problem_id; 749 die "Global problem $problemID for set $setID not found." unless $problemRecord; 750 751 if ($forUsers) { 752 # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page 753 # So we only need to make changes to the UserProblem record and only then if we are overriding a value 754 # in the GlobalProblem record or for fields unique to the UserProblem record. 755 756 my @userIDs = @editForUser; 757 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 758 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 759 foreach my $record (@userProblemRecords) { 760 761 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 762 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 763 next unless canChange($forUsers, $field); 764 765 my $override = $r->param("problem.$problemID.$field.override"); 766 if (defined $override && $override eq $field) { 767 768 my $param = $r->param("problem.$problemID.$field"); 769 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 770 my $unlabel = $undoLabels{$field}->{$param}; 771 $param = $unlabel if defined $unlabel; 772 $changed ||= changed($record->$field, $param); 773 $record->$field($param); 774 } else { 775 $changed ||= changed($record->$field, undef); 776 $record->$field(undef); 777 } 778 779 } 780 781 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 782 next unless canChange($forUsers, $field); 783 784 my $param = $r->param("problem.$problemID.$field"); 785 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 786 my $unlabel = $undoLabels{$field}->{$param}; 787 $param = $unlabel if defined $unlabel; 788 $changed ||= changed($record->$field, $param); 789 $record->$field($param); 790 } 791 $db->putUserProblem($record) if $changed; 792 } 793 } else { 794 # Since we're editing for ALL set users, we will make changes to the GlobalProblem record. 795 # We may also have instances where a field is unique to the UserProblem record but we want 796 # all users to (at least initially) have the same value 797 798 # this only edits a globalProblem record 799 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 800 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 801 next unless canChange($forUsers, $field); 802 803 my $param = $r->param("problem.$problemID.$field"); 804 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 805 my $unlabel = $undoLabels{$field}->{$param}; 806 $param = $unlabel if defined $unlabel; 807 $changed ||= changed($problemRecord->$field, $param); 808 $problemRecord->$field($param); 809 } 810 $db->putGlobalProblem($problemRecord) if $changed; 811 812 813 # sometimes (like for status) we might want to change an attribute in 814 # the userProblem record for every assigned user 815 # However, since this data is stored in the UserProblem records, 816 # it won't be displayed once its been changed and if you hit "Save Changes" again 817 # it gets erased 818 819 # So we'll enforce that there be something worth putting in all the UserProblem records 820 # This also will make hitting "Save Changes" on the global page MUCH faster 821 my %useful; 822 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 823 my $param = $r->param("problem.$problemID.$field"); 824 $useful{$field} = 1 if defined $param and $param ne ""; 825 } 826 827 if (keys %useful) { 828 my @userIDs = $db->listProblemUsers($setID, $problemID); 829 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 830 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 831 foreach my $record (@userProblemRecords) { 832 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 833 foreach my $field ( keys %useful ) { 834 next unless canChange($forUsers, $field); 835 836 my $param = $r->param("problem.$problemID.$field"); 837 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 838 my $unlabel = $undoLabels{$field}->{$param}; 839 $param = $unlabel if defined $unlabel; 840 $changed ||= changed($record->$field, $param); 841 $record->$field($param); 842 } 843 $db->putUserProblem($record) if $changed; 844 } 845 } 846 } 847 } 848 849 # Mark the specified problems as correct for all users 850 foreach my $problemID ($r->param('markCorrect')) { 851 my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID)); 852 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 853 foreach my $record (@userProblemRecords) { 854 if (defined $record && ($record->status eq "" || $record->status < 1)) { 855 $record->status(1); 856 $record->attempted(1); 857 $db->putUserProblem($record); 858 } 859 } 860 } 861 862 # Delete all problems marked for deletion 863 foreach my $problemID ($r->param('deleteProblem')) { 864 $db->deleteGlobalProblem($setID, $problemID); 865 } 866 867 ##################################################################### 868 # Add blank problem if needed 869 ##################################################################### 870 if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { 871 my $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setID)); 872 ################################################## 873 # make local copy of the blankProblem 874 ################################################## 875 my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; 876 my $problemContents = WeBWorK::Utils::readFile($blank_file_path); 877 my $new_file_path = "set$setID/".BLANKPROBLEM(); 878 my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); 879 local(*TEMPFILE); 880 open(TEMPFILE, ">$fullPath") or warn "Can't write to file $fullPath"; 881 print TEMPFILE $problemContents; 882 close(TEMPFILE); 883 884 ################################################# 885 # Update problem record 886 ################################################# 887 my $problemRecord = $self->addProblemToSet( 888 setName => $setID, 889 sourceFile => $new_file_path, 890 problemID => $targetProblemNumber, #added to end of set 891 ); 892 $self->assignProblemToAllSetUsers($problemRecord); 893 $self->addgoodmessage("Added $new_file_path to ". $setID. " as problem $targetProblemNumber") ; 894 } 895 896 # Sets the specified header to "" so that the default file will get used. 897 foreach my $header ($r->param('defaultHeader')) { 898 $setRecord->$header(""); 899 } 900 } 901 902 # Leftover code from when there were up/down buttons 903 904 # } else { 905 # # Look for up and down buttons 906 # my $index = 2; 907 # while ($index <= scalar @problemList) { 908 # if (defined $r->param("move.up.$index.x")) { 909 # moveme($index-1, $db, $setID, @problemList); 910 # } 911 # $index++; 912 # } 913 # $index = 1; 914 # 915 # while ($index < scalar @problemList) { 916 # if (defined $r->param("move.down.$index.x")) { 917 # moveme($index, $db, $setID, @problemList); 918 # } 919 # $index++; 920 # } 921 # } 922 923 924 # This erases any sticky fields if the user saves changes, resets the form, or reorders problems 925 # It may not be obvious why this is necessary when saving changes or reordering problems 926 # but when the problems are reorder the param problem.1.source_file needs to be the source 927 # file of the problem that is NOW #1 and not the problem that WAS #1. 928 unless (defined $r->param('refresh')) { 929 930 # reset all the parameters dealing with set/problem/header information 931 # if the current naming scheme is changed/broken, this could reek havoc 932 # on all kinds of things 933 foreach my $param ($r->param) { 934 $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; 935 } 936 } 937 } 938 939 # helper method for debugging 940 sub definedness ($) { 941 my ($variable) = @_; 942 943 return "undefined" unless defined $variable; 944 return "empty" unless $variable ne ""; 945 return $variable; 946 } 947 948 # helper method for checking if two things are different 949 # the return values will usually be thrown away, but they could be useful for debugging 950 sub changed ($$) { 951 my ($first, $second) = @_; 952 953 return "def/undef" if defined $first and not defined $second; 954 return "undef/def" if not defined $first and defined $second; 955 return "" if not defined $first and not defined $second; 956 return "ne" if $first ne $second; 957 return ""; # if they're equal, there's no change 958 } 959 960 # helper method that determines for how many users at a time a field can be changed 961 # none means it can't be changed for anyone 962 # any means it can be changed for anyone 963 # one means it can ONLY be changed for one at a time. (eg problem_seed) 964 # all means it can ONLY be changed for all at a time. (eg set_header) 965 sub canChange ($$) { 966 my ($forUsers, $field) = @_; 967 968 my %properties = %{ FIELD_PROPERTIES() }; 969 my $forOneUser = $forUsers == 1; 970 971 my $howManyCan = $properties{$field}->{override}; 972 973 return 0 if $howManyCan eq "none"; 974 return 1 if $howManyCan eq "any"; 975 return 1 if $howManyCan eq "one" && $forOneUser; 976 return 1 if $howManyCan eq "all" && !$forUsers; 977 return 0; # FIXME: maybe it should default to 1? 978 } 979 980 # helper method that determines if a file is valid and returns a pretty error message 981 sub checkFile ($) { 982 my ($self, $file) = @_; 983 984 my $r = $self->r; 985 my $ce = $r->ce; 986 987 return "No source file specified" unless $file; 988 $file = $ce->{courseDirs}->{templates} . '/' . $file unless $file =~ m|^/|; 989 990 my $text = "This source file "; 991 my $fileError; 992 return "" if -e $file && -f $file && -r $file; 993 return $text . "is not readable!" if -e $file && -f $file; 994 return $text . "is a directory!" if -d $file; 995 return $text . "does not exist!" unless -e $file; 996 return $text . "is not a plain file!"; 997 } 998 999 # don't show view options -- we provide display mode controls for headers/problems separately 1000 sub options { 1001 return ""; 1002 } 1003 1004 # Creates two separate tables, first of the headers, and the of the problems in a given set 1005 # If one or more users are specified in the "editForUser" param, only the data for those users 1006 # becomes editable, not all the data 1007 sub body { 1008 1009 my ($self) = @_; 1010 my $r = $self->r; 1011 my $db = $r->db; 1012 my $ce = $r->ce; 1013 my $authz = $r->authz; 1014 my $userID = $r->param('user'); 1015 my $urlpath = $r->urlpath; 1016 my $courseID = $urlpath->arg("courseID"); 1017 my $setID = $urlpath->arg("setID"); 1018 my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; 1019 1020 my $userRecord = $db->getUser($userID) or die "No record for user $userID."; 1021 # Check permissions 1022 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 1023 unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); 1024 1025 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") 1026 unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); 1027 1028 my @editForUser = $r->param('editForUser'); 1029 1030 # Check that every user that we're editing for has a valid UserSet 1031 my @assignedUsers; 1032 my @unassignedUsers; 1033 if (scalar @editForUser) { 1034 foreach my $ID (@editForUser) { 1035 if ($db->getUserSet($ID, $setID)) { 1036 unshift @assignedUsers, $ID; 1037 } else { 1038 unshift @unassignedUsers, $ID; 1039 } 1040 } 1041 @editForUser = sort @assignedUsers; 1042 $r->param("editForUser", \@editForUser); 1043 1044 if (scalar @editForUser && scalar @unassignedUsers) { 1045 print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); 1046 } elsif (scalar @editForUser == 0) { 1047 print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); 1048 print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); 1049 } 1050 } 1051 1052 # some useful booleans 1053 my $forUsers = scalar(@editForUser); 1054 my $forOneUser = $forUsers == 1; 1055 1056 # If you're editing for users, initially their records will be different but 1057 # if you make any changes to them they will be the same. 1058 # if you're editing for one user, the problems shown should be his/hers 1059 my $userToShow = $forUsers ? $editForUser[0] : $userID; 1060 1061 my $userCount = $db->listUsers(); 1062 my $setCount = $db->listGlobalSets(); # if $forOneUser; 1063 my $setUserCount = $db->countSetUsers($setID); 1064 my $userSetCount = $db->countUserSets($editForUser[0]) if $forOneUser; 1065 1066 1067 my $editUsersAssignedToSetURL = $self->systemLink( 1068 $urlpath->newFromModule( 1069 "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", 1070 courseID => $courseID, setID => $setID)); 1071 my $editSetsAssignedToUserURL = $self->systemLink( 1072 $urlpath->newFromModule( 1073 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1074 courseID => $courseID, userID => $editForUser[0])) if $forOneUser; 1075 1076 1077 my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); 1078 my $setDetailURL = $self->systemLink($setDetailPage, authen=>0); 1079 1080 1081 my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); 1082 my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; 1083 1084 $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; 1085 $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; 1086 1087 if ($forUsers) { 1088 ############################################## 1089 # calculate links for the users being edited: 1090 ############################################## 1091 my @userLinks = (); 1092 foreach my $userID (@editForUser) { 1093 my $u = $db->getUser($userID); 1094 my $email_address = $u->email_address; 1095 my $line = $u->last_name.", ".$u->first_name." (".CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id."). Assigned to "; 1096 my $editSetsAssignedToUserURL = $self->systemLink( 1097 $urlpath->newFromModule( 1098 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1099 courseID => $courseID, userID => $u->user_id)); 1100 $line .= CGI::a({href=>$editSetsAssignedToUserURL}, 1101 $self->setCountMessage($db->countUserSets($u->user_id), $setCount)); 1102 unshift @userLinks,$line; 1103 } 1104 @userLinks = sort @userLinks; 1105 1106 print CGI::table({border=>2,cellpadding=>10}, 1107 CGI::Tr({}, 1108 CGI::td([ 1109 "Editing problem set ".CGI::strong($setID)." data for these individual students:".CGI::br(). 1110 CGI::strong(join CGI::br(), @userLinks), 1111 CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set."), 1112 1113 ]) 1114 ) 1115 ); 1116 } else { 1117 print CGI::table({border=>2,cellpadding=>10}, 1118 CGI::Tr({}, 1119 CGI::td([ 1120 "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 1121 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", 1122 1123 ]) 1124 ) 1125 ); 1126 } 1127 1128 # handle renumbering of problems if necessary 1129 print CGI::a({name=>"problems"}); 1130 1131 my %newProblemNumbers = (); 1132 my $maxProblemNumber = -1; 1133 for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { 1134 $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); 1135 $maxProblemNumber = $jj if $jj > $maxProblemNumber; 1136 } 1137 1138 my $forceRenumber = $r->param('force_renumber') || 0; 1139 handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); 1140 1141 my %properties = %{ FIELD_PROPERTIES() }; 1142 1143 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1144 my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; 1145 push @active_modes, 'None'; 1146 my $default_header_mode = $r->param('header.displaymode') || 'None'; 1147 my $default_problem_mode = $r->param('problem.displaymode') || 'None'; 1148 1149 ##################################################################### 1150 # Browse available header/problem files 1151 ##################################################################### 1152 1153 my $templates = $r->ce->{courseDirs}->{templates}; 1154 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} }; 1155 my $skip = join("|", keys %probLibs); 1156 1157 my @headerFileList = listFilesRecursive( 1158 $templates, 1159 qr/header.*\.pg$/i, # match these files 1160 qr/^(?:$skip|CVS)$/, # prune these directories 1161 0, # match against file name only 1162 1, # prune against path relative to $templates 1163 ); 1164 1165 # this just takes too much time to search 1166 # my @problemFileList = listFilesRecursive( 1167 # $templates, 1168 # qr/\.pg$/i, # problem files don't say problem 1169 # qr/^(?:$skip|CVS)$/, # prune these directories 1170 # 0, # match against file name only 1171 # 1, # prune against path relative to $templates 1172 # ); 1173 1174 # Display a useful warning message 1175 if ($forUsers) { 1176 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . 1177 ($forOneUser ? "" : "s") . " listed above.")); 1178 } else { 1179 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); 1180 } 1181 1182 print CGI::start_form({method=>"POST", action=>$setDetailURL}); 1183 print $self->hiddenEditForUserFields(@editForUser); 1184 print $self->hidden_authen_fields; 1185 print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); 1186 print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); 1187 1188 # spacing 1189 print CGI::p(); 1190 1191 ##################################################################### 1192 # Display general set information 1193 ##################################################################### 1194 1195 print CGI::start_table({border=>1, cellpadding=>4}); 1196 print CGI::Tr({}, CGI::th({}, [ 1197 "General Information", 1198 ])); 1199 1200 # this is kind of a hack -- we need to get a user record here, so we can 1201 # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so 1202 # FieldHTML doesn't have to fetch it itself. 1203 my $userSetRecord = $db->getUserSet($userToShow, $setID); 1204 1205 print CGI::Tr({}, CGI::td({}, [ 1206 $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), 1207 ])); 1208 print CGI::end_table(); 1209 1210 # spacing 1211 print CGI::p(); 1212 1213 1214 ##################################################################### 1215 # Display header information 1216 ##################################################################### 1217 my @headers = @{ HEADER_ORDER() }; 1218 my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); 1219 my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); 1220 my @headerFiles = map { $setRecord->{$_} } @headers; 1221 if (scalar @headers and not $forUsers) { 1222 1223 print CGI::start_table({border=>1, cellpadding=>4}); 1224 print CGI::Tr({}, CGI::th({}, [ 1225 "Headers", 1226 # "Data", 1227 "Display Mode: " . 1228 CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. 1229 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1230 ])); 1231 1232 my %header_html; 1233 1234 my %error; 1235 foreach my $header (@headers) { 1236 my $headerFile = $r->param("set.$setID.$header") || $setRecord->{$header} || $headerDefaults{$header}; 1237 1238 $error{$header} = $self->checkFile($headerFile); 1239 unless ($error{$header}) { 1240 my @temp = renderProblems( r=> $r, 1241 user => $db->getUser($userToShow), 1242 displayMode=> $default_header_mode, 1243 problem_number=> 0, 1244 this_set => $db->getMergedSet($userToShow, $setID), 1245 problem_list => [$headerFile], 1246 ); 1247 $header_html{$header} = $temp[0]; 1248 } 1249 } 1250 1251 foreach my $header (@headers) { 1252 1253 my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); 1254 my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $header, make_local_copy => 1 }); 1255 1256 my $viewHeaderPage = $urlpath->new(type => $headerModules{$header}, args => { courseID => $courseID, setID => $setID }); 1257 my $viewHeaderLink = $self->systemLink($viewHeaderPage); 1258 1259 print CGI::Tr({}, CGI::td({}, [ 1260 CGI::start_table({border => 0, cellpadding => 0}) . 1261 CGI::Tr({}, CGI::td({}, $properties{$header}->{name})) . 1262 CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . 1263 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . 1264 # CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "defaultHeader", value => $header, label => "Use Default"}))) . 1265 CGI::end_table(), 1266 # "", 1267 # CGI::input({ name => "set.$setID.$header", value => $setRecord->{$header}, size => 50}) . 1268 # join ("\n", $self->FieldHTML($userToShow, $setID, $problemID, "source_file")) . 1269 # CGI::br() . CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}), 1270 1271 comboBox({ 1272 name => "set.$setID.$header", 1273 request => $r, 1274 default => $r->param("set.$setID.$header") || $setRecord->{$header}, 1275 multiple => 0, 1276 values => ["", @headerFileList], 1277 labels => { "" => "Use Default Header File" }, 1278 }) . 1279 ($error{$header} ? 1280 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$header}) 1281 : CGI::div({class=> "RenderSolo"}, $header_html{$header}->{body_text}) 1282 ), 1283 ])); 1284 } 1285 1286 print CGI::end_table(); 1287 } else { 1288 print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); 1289 } 1290 1291 # spacing 1292 print CGI::p(); 1293 1294 1295 ##################################################################### 1296 # Display problem information 1297 ##################################################################### 1298 1299 my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); 1300 1301 # get global problem records for all problems in one go 1302 my %GlobalProblems; 1303 my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; 1304 @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); 1305 1306 # if needed, get user problem records for all problems in one go 1307 my (%UserProblems, %MergedProblems); 1308 if ($forOneUser) { 1309 my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; 1310 @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); 1311 @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); 1312 } 1313 1314 if (scalar @problemIDList) { 1315 1316 print CGI::start_table({border=>1, cellpadding=>4}); 1317 print CGI::Tr({}, CGI::th({}, [ 1318 "Problems", 1319 "Data", 1320 "Display Mode: " . 1321 CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. 1322 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1323 ])); 1324 1325 my %shownYet; 1326 my $repeatFile; 1327 foreach my $problemID (@problemIDList) { 1328 1329 my $problemRecord; 1330 if ($forOneUser) { 1331 #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); 1332 $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam 1333 } else { 1334 #$problemRecord = $db->getGlobalProblem($setID, $problemID); 1335 $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam 1336 } 1337 1338 #$self->addgoodmessage(""); 1339 #$self->addbadmessage($problemRecord->toString()); 1340 1341 1342 my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1343 my $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 1344 1345 1346 # FIXME: should we have an "act as" type link here when editing for multiple users? 1347 my $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1348 my $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); 1349 1350 my @fields = @{ PROBLEM_FIELDS() }; 1351 push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser; 1352 1353 my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; 1354 1355 # warn of repeat problems 1356 if (defined $shownYet{$problemFile}) { 1357 $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; 1358 } else { 1359 $shownYet{$problemFile} = $problemID; 1360 $repeatFile = ""; 1361 } 1362 1363 my $error = $self->checkFile($problemFile); 1364 my @problem_html; 1365 unless ($error) { 1366 @problem_html = renderProblems( r=> $r, 1367 user => $db->getUser($userToShow), 1368 displayMode=> $default_problem_mode, 1369 problem_number=> $problemID, 1370 this_set => $db->getMergedSet($userToShow, $setID), 1371 problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, 1372 problem_list => [$problemRecord->source_file], 1373 ); 1374 } 1375 1376 print CGI::Tr({}, CGI::td({}, [ 1377 CGI::start_table({border => 0, cellpadding => 1}) . 1378 CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . 1379 CGI::Tr({}, CGI::td({}, CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it"))) . 1380 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")))) . 1381 ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . 1382 # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . 1383 ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . 1384 CGI::end_table(), 1385 $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}), 1386 # A comprehensive list of problems is just TOO big to be handled well 1387 # comboBox({ 1388 # name => "set.$setID.$problemID", 1389 # request => $r, 1390 # default => $problemRecord->{problem_id}, 1391 # multiple => 0, 1392 # values => \@problemFileList, 1393 # }) . 1394 1395 join ("\n", $self->FieldHTML( 1396 $userToShow, 1397 $setID, 1398 $problemID, 1399 $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam 1400 $UserProblems{$problemID}, # pass previously fetched user record to FieldHTML --sam 1401 "source_file" 1402 )) . 1403 CGI::br() . 1404 ($error ? 1405 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) 1406 : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) 1407 ) . 1408 ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), 1409 ])); 1410 } 1411 1412 1413 # print final lines 1414 print CGI::end_table(); 1415 print CGI::checkbox({ 1416 label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", 1417 name=>"force_renumber", value=>"1"}); 1418 print CGI::p(<<EOF); 1419 Any time problem numbers are intentionally changed, the problems will 1420 always be renumbered consecutively, starting from one. When deleting 1421 problems, gaps will be left in the numbering unless the box above is 1422 checked. 1423 EOF 1424 print CGI::p("It is before the open date. You probably want to renumber the problems if you are deleting some from the middle.") if ($setRecord->open_date>time()); 1425 print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); 1426 1427 } else { 1428 print CGI::p(CGI::b("This set doesn't contain any problems yet.")); 1429 } 1430 # always allow one to add a new problem. 1431 print CGI::checkbox({ 1432 label=> "Add blank problem template to end of homework set", 1433 name=>"add_blank_problem", value=>"1"} 1434 ),CGI::br(),CGI::br(), 1435 CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), 1436 CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), 1437 "(Any unsaved changes will be lost.)" 1438 ; 1439 1440 1441 1442 #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); 1443 #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); 1444 # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME 1445 #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); 1446 1447 print CGI::end_form(); 1448 1449 return ""; 1450 } 1451 1452 1; 1453 1454 =head1 AUTHOR 1455 1456 Written by Robert Van Dam, toenail (at) cif.rochester.edu 1457 1458 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |