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