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