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