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