Parent Directory
| 
Revision Log
Add set-level proctor login password for proctored gateway/quiz assignments, improve handling of proctor keys and permissions for proctored assignments, bug fixes for recently added features. This commit - adds the ability to specify a set-level proctor for proctored gateway/quiz assignments. this is done by adding a proctor with a username "set_id:setName", where "setName" is the name of the set, adding a "restricted_login_proctor" field to the set tables in the database, and allowing Authen::Proctor and ContentGenerator::LoginProctor to appropriately deal with this possibility. - updates proctor permissions and status in global.conf.dist, changing the old "proctor_quiz" permission level (3) into two levels, "proctor_quiz_login" and "proctor_quiz_grade". wwdb_upgrade includes a stanza to make this change to proctors that already exist in courses. - adds a "Proctor" status in %statuses in global.conf, with no valid behaviors. this allows the creation of proctor users in a course who have the permissionLevel to login (and thus proctor), but not to access the course. - improves GatewayQuiz explanatory messages when scores or work are hidden. - improves GatewayQuiz proctor key management, especially for tests with more than one allowed attempt. this includes adding a deleteAllProctorKeys() method to DB.pm. - updates Instructor Tools, UserList.pm and ProblemSetDetail to deal with set-level proctoring. c.f. the note below about the ramifications of these changes. - updates ProblemSetList to deal with new problem set fields set_locations and set-level proctors that are located in a different database table than the set data. - fixes bugs in UserList and ProblemSetDetail dealing with the setting of hide_score, hide_score_by_problem, and time_limit_cap. This update hides set-level proctor users from the classlist editor (UserList.pm) and instructor tools (Index.pm) interfaces. They can be created, modified, and deleted at the homework sets editor page (ProblemSetDetail.pm) only, and there only implicitly: we never indicate that a user is being created or modified behind the screen.
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 cryptPassword); 32 use WeBWorK::Utils::Tasks qw(renderProblems); 33 use WeBWorK::Debug; 34 # IP RESTRICT 35 use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 36 37 # Important Note: the following two sets of constants may seem similar 38 # but they are functionally and semantically different 39 40 # these constants determine which fields belong to what type of record 41 use constant SET_FIELDS => [qw(set_header hardcopy_header open_date due_date answer_date published restrict_ip relax_restrict_ip assignment_type attempts_per_version version_time_limit time_limit_cap versions_per_interval time_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work)]; 42 use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts)]; 43 use constant USER_PROBLEM_FIELDS => [qw(problem_seed status num_correct num_incorrect)]; 44 45 # these constants determine what order those fields should be displayed in 46 use constant HEADER_ORDER => [qw(set_header hardcopy_header)]; 47 use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts attempted last_answer num_correct num_incorrect)]; 48 49 # we exclude the gateway set fields from the set field order, because they 50 # are only displayed for sets that are gateways. this results in a bit of 51 # convoluted logic below, but it saves burdening people who are only using 52 # homework assignments with all of the gateway parameters 53 # FIXME: in the long run, we may want to let hide_score and hide_work be 54 # FIXME: set for non-gateway assignments. right now (11/30/06) they are 55 # FIXME: only used for gateways 56 use constant SET_FIELD_ORDER => [qw(open_date due_date answer_date published restrict_ip relax_restrict_ip assignment_type)]; 57 # 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)]; 58 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_score_by_problem hide_work)]; 59 60 # this constant is massive hash of information corresponding to each db field. 61 # override indicates for how many students at a time a field can be overridden 62 # this hash should make it possible to NEVER have explicitly: if (somefield) { blah() } 63 # 64 # All but name are optional 65 # some_field => { 66 # name => "Some Field", 67 # type => "edit", # edit, choose, hidden, view - defines how the data is displayed 68 # size => "50", # size of the edit box (if any) 69 # override => "none", # none, one, any, all - defines for whom this data can/must be overidden 70 # module => "problem_list", # WeBWorK module 71 # default => 0 # if a field cannot default to undefined/empty what should it default to 72 # labels => { # special values can be hashed to display labels 73 # 1 => "Yes", 74 # 0 => "No", 75 # }, 76 # convertby => 60, # divide incoming database field values by this, and multiply when saving 77 78 use constant BLANKPROBLEM => 'blankProblem.pg'; 79 80 use constant FIELD_PROPERTIES => { 81 # Set information 82 set_header => { 83 name => "Set Header", 84 type => "edit", 85 size => "50", 86 override => "all", 87 module => "problem_list", 88 default => "", 89 }, 90 hardcopy_header => { 91 name => "Hardcopy Header", 92 type => "edit", 93 size => "50", 94 override => "all", 95 module => "hardcopy_preselect_set", 96 default => "", 97 }, 98 open_date => { 99 name => "Opens", 100 type => "edit", 101 size => "26", 102 override => "any", 103 labels => { 104 #0 => "None Specified", 105 "" => "None Specified", 106 }, 107 }, 108 due_date => { 109 name => "Answers Due", 110 type => "edit", 111 size => "26", 112 override => "any", 113 labels => { 114 #0 => "None Specified", 115 "" => "None Specified", 116 }, 117 }, 118 answer_date => { 119 name => "Answers Available", 120 type => "edit", 121 size => "26", 122 override => "any", 123 labels => { 124 #0 => "None Specified", 125 "" => "None Specified", 126 }, 127 }, 128 published => { 129 name => "Visible to Students", 130 type => "choose", 131 override => "all", 132 choices => [qw( 0 1 )], 133 labels => { 134 1 => "Yes", 135 0 => "No", 136 }, 137 }, 138 restrict_ip => { 139 name => "Restrict Access by IP", 140 type => "choose", 141 override => "any", 142 choices => [qw( No RestrictTo DenyFrom )], 143 labels => { 144 No => "No", 145 RestrictTo => "Restrict To", 146 DenyFrom => "Deny From", 147 }, 148 default => 'No', 149 }, 150 relax_restrict_ip => { 151 name => "Relax IP restrictions when?", 152 type => "choose", 153 override => "any", 154 choices => [qw( No AfterAnswerDate AfterVersionAnswerDate )], 155 labels => { 156 No => "Never", 157 AfterAnswerDate => "After set answer date", 158 AfterVersionAnswerDate => "(gw/quiz) After version answer date", 159 }, 160 default => 'No', 161 }, 162 assignment_type => { 163 name => "Assignment type", 164 type => "choose", 165 override => "all", 166 choices => [qw( default gateway proctored_gateway )], 167 labels => { default => "homework", 168 gateway => "gateway/quiz", 169 proctored_gateway => "proctored gateway/quiz", 170 }, 171 }, 172 version_time_limit => { 173 name => "Test Time Limit (min)", 174 type => "edit", 175 size => "4", 176 override => "any", 177 # labels => { "" => 0 }, # I'm not sure this is quite right 178 convertby => 60, 179 }, 180 time_limit_cap => { 181 name => "Cap Test Time at Set Due Date?", 182 type => "choose", 183 override => "all", 184 choices => [qw(0 1)], 185 labels => { '0' => 'No', '1' => 'Yes' }, 186 }, 187 attempts_per_version => { 188 name => "Number of Graded Submissions per Test", 189 type => "edit", 190 size => "3", 191 override => "any", 192 # labels => { "" => 1 }, 193 }, 194 time_interval => { 195 name => "Time Interval for New Test Versions (min; 0=infty)", 196 type => "edit", 197 size => "5", 198 override => "any", 199 # labels => { "" => 0 }, 200 convertby => 60, 201 }, 202 versions_per_interval => { 203 name => "Number of Tests per Time Interval (0=infty)", 204 type => "edit", 205 size => "3", 206 override => "any", 207 default => "0", 208 format => '[0-9]+', # an integer, possibly zero 209 # labels => { "" => 0 }, 210 # labels => { "" => 1 }, 211 }, 212 problem_randorder => { 213 name => "Order Problems Randomly", 214 type => "choose", 215 choices => [qw( 0 1 )], 216 override => "any", 217 labels => { 0 => "No", 1 => "Yes" }, 218 }, 219 problems_per_page => { 220 name => "Number of Problems per Page (0=all)", 221 type => "edit", 222 size => "3", 223 override => "any", 224 default => "0", 225 # labels => { "" => 0 }, 226 }, 227 'hide_score:hide_score_by_problem' => { 228 name => "Show Scores on Finished Assignments?", 229 type => "choose", 230 choices => [ qw( N: Y:N BeforeAnswerDate:N Y:Y BeforeAnswerDate:Y ) ], 231 override => "any", 232 labels => { 'N:' => 'Yes', 'Y:N' => 'No', 'BeforeAnswerDate:N' => 'Only after set answer date', 'Y:Y' => 'Totals only (not problem scores)', 'BeforeAnswerDate:Y' => 'Totals only, only after answer date' }, 233 }, 234 hide_work => { 235 name => "Show Student Work on Finished Tests", 236 type => "choose", 237 choices => [ qw(N Y BeforeAnswerDate) ], 238 override => "any", 239 labels => { 'N' => "Yes", 'Y' => "No", 'BeforeAnswerDate' => 'Only after set answer date' }, 240 }, 241 # in addition to the set fields above, there are a number of things 242 # that are set but aren't in this table: 243 # any set proctor information (which is in the user tables), and 244 # any set location restriction information (which is in the 245 # location tables) 246 # 247 # Problem information 248 source_file => { 249 name => "Source File", 250 type => "edit", 251 size => 50, 252 override => "any", 253 default => "", 254 }, 255 value => { 256 name => "Weight", 257 type => "edit", 258 size => 6, 259 override => "any", 260 }, 261 max_attempts => { 262 name => "Max attempts", 263 type => "edit", 264 size => 6, 265 override => "any", 266 labels => { 267 "-1" => "unlimited", 268 }, 269 }, 270 problem_seed => { 271 name => "Seed", 272 type => "edit", 273 size => 6, 274 override => "one", 275 276 }, 277 status => { 278 name => "Status", 279 type => "edit", 280 size => 6, 281 override => "one", 282 default => 0, 283 }, 284 attempted => { 285 name => "Attempted", 286 type => "hidden", 287 override => "none", 288 choices => [qw( 0 1 )], 289 labels => { 290 1 => "Yes", 291 0 => "No", 292 }, 293 default => 0, 294 }, 295 last_answer => { 296 name => "Last Answer", 297 type => "hidden", 298 override => "none", 299 }, 300 num_correct => { 301 name => "Correct", 302 type => "hidden", 303 override => "none", 304 default => 0, 305 }, 306 num_incorrect => { 307 name => "Incorrect", 308 type => "hidden", 309 override => "none", 310 default => 0, 311 }, 312 }; 313 314 # Create a table of fields for the given parameters, one row for each db field 315 # if only the setID is included, it creates a table of set information 316 # if the problemID is included, it creates a table of problem information 317 sub FieldTable { 318 my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord) = @_; 319 320 my $r = $self->r; 321 my @editForUser = $r->param('editForUser'); 322 my $forUsers = scalar(@editForUser); 323 my $forOneUser = $forUsers == 1; 324 325 my @fieldOrder; 326 327 # needed for gateway output 328 my $gwFields = ''; 329 330 # needed for ip restrictions 331 my $ipFields = ''; 332 my $ipDefaults; 333 my $numLocations = 0; 334 my $ipOverride; 335 336 # needed for set-level proctor 337 my $procFields = ''; 338 339 if (defined $problemID) { 340 @fieldOrder = @{ PROBLEM_FIELD_ORDER() }; 341 } else { 342 @fieldOrder = @{ SET_FIELD_ORDER() }; 343 344 ($gwFields, $ipFields, $numLocations, $procFields) = $self->extraSetFields($userID, $setID, $globalRecord, $userRecord, $forUsers); 345 } 346 347 my $output = CGI::start_table({border => 0, cellpadding => 1}); 348 if ($forUsers) { 349 $output .= CGI::Tr({}, 350 CGI::th({colspan=>"2"}, " "), 351 CGI::th({colspan=>"1"}, "User Values"), 352 CGI::th({}, "Class values"), 353 ); 354 } 355 foreach my $field (@fieldOrder) { 356 my %properties = %{ FIELD_PROPERTIES()->{$field} }; 357 358 # we don't show the ip restriction option if there are 359 # no defined locations, nor the relax_restrict_ip option 360 # if we're not restricting ip access 361 next if ( $field eq 'restrict_ip' && ! $numLocations ); 362 next if ($field eq 'relax_restrict_ip' && 363 (! $numLocations || 364 ($forUsers && $userRecord->restrict_ip eq 'No') || 365 (! $forUsers && 366 ( $globalRecord->restrict_ip eq '' || 367 $globalRecord->restrict_ip eq 'No' ) ) ) ); 368 369 unless ($properties{type} eq "hidden") { 370 $output .= CGI::Tr({}, CGI::td({}, [$self->FieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field)])) . "\n"; 371 } 372 373 # finally, put in extra fields that are exceptions to the 374 # usual display mechanism 375 if ( $field eq 'restrict_ip' && $ipFields ) { 376 $output .= $ipFields; 377 } 378 379 if ( $field eq 'assignment_type' ) { 380 $output .= "$procFields\n$gwFields\n"; 381 } 382 } 383 384 if (defined $problemID) { 385 #my $problemRecord = $r->{db}->getUserProblem($userID, $setID, $problemID); 386 my $problemRecord = $userRecord; # we get this from the caller, hopefully 387 $output .= CGI::Tr({}, CGI::td({}, ["","Attempts", ($problemRecord->num_correct || 0) + ($problemRecord->num_incorrect || 0)])) if $forOneUser; 388 } 389 $output .= CGI::end_table(); 390 391 return $output; 392 } 393 394 # Returns a list of information and HTML widgets 395 # for viewing and editing the specified db fields 396 # if only the setID is included, it creates a list of set information 397 # if the problemID is included, it creates a list of problem information 398 sub FieldHTML { 399 my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $field) = @_; 400 401 my $r = $self->r; 402 my $db = $r->db; 403 my @editForUser = $r->param('editForUser'); 404 my $forUsers = scalar(@editForUser); 405 my $forOneUser = $forUsers == 1; 406 407 #my ($globalRecord, $userRecord, $mergedRecord); 408 #if (defined $problemID) { 409 # $globalRecord = $db->getGlobalProblem($setID, $problemID); 410 # $userRecord = $db->getUserProblem($userID, $setID, $problemID); 411 # #$mergedRecord = $db->getMergedProblem($userID, $setID, $problemID); # never used --sam 412 #} else { 413 # $globalRecord = $db->getGlobalSet($setID); 414 # $userRecord = $db->getUserSet($userID, $setID); 415 # #$mergedRecord = $db->getMergedSet($userID, $setID); # never user --sam 416 #} 417 418 return "No data exists for set $setID and problem $problemID" unless $globalRecord; 419 return "No user specific data exists for user $userID" if $forOneUser and $globalRecord and not $userRecord; 420 421 my %properties = %{ FIELD_PROPERTIES()->{$field} }; 422 my %labels = %{ $properties{labels} }; 423 return "" if $properties{type} eq "hidden"; 424 return "" if $properties{override} eq "one" && not $forOneUser; 425 return "" if $properties{override} eq "none" && not $forOneUser; 426 return "" if $properties{override} eq "all" && $forUsers; 427 428 my $edit = ($properties{type} eq "edit") && ($properties{override} ne "none"); 429 my $choose = ($properties{type} eq "choose") && ($properties{override} ne "none"); 430 431 # FIXME: allow one selector to set multiple fields 432 # my $globalValue = $globalRecord->{$field}; 433 # my $userValue = $userRecord->{$field}; 434 my ($globalValue, $userValue) = ('', ''); 435 my $blankfield = ''; 436 if ( $field =~ /:/ ) { 437 foreach my $f ( split(/:/, $field) ) { 438 # hmm. this directly references the data in the 439 # record rather than calling the access method, 440 # thereby avoiding errors if the userRecord is 441 # undefined. that seems a bit suspect, but it's 442 # used below so we'll leave it here. 443 $globalValue .= $globalRecord->{$f} . ":"; 444 $userValue .= $userRecord->{$f} . ":"; 445 $blankfield .= ":"; 446 } 447 $globalValue =~ s/:$//; 448 $userValue =~ s/:$//; 449 $blankfield =~ s/:$//; 450 } else { 451 $globalValue = $globalRecord->{$field}; 452 $userValue = $userRecord->{$field}; 453 } 454 455 # use defined instead of value in order to allow 0 to printed, e.g. for the 'value' field 456 $globalValue = (defined($globalValue)) ? ($labels{$globalValue || ""} || $globalValue) : ""; 457 $userValue = (defined($userValue)) ? ($labels{$userValue || ""} || $userValue) : ""; 458 459 if ($field =~ /_date/) { 460 $globalValue = $self->formatDateTime($globalValue) if defined $globalValue && $globalValue ne $labels{""}; 461 $userValue = $self->formatDateTime($userValue) if defined $userValue && $userValue ne $labels{""}; 462 } 463 464 if ( defined($properties{convertby}) && $properties{convertby} ) { 465 $globalValue = $globalValue/$properties{convertby} if $globalValue; 466 $userValue = $userValue/$properties{convertby} if $userValue; 467 } 468 469 # check to make sure that a given value can be overridden 470 my %canOverride = map { $_ => 1 } (@{ PROBLEM_FIELDS() }, @{ SET_FIELDS() }); 471 my $check = $canOverride{$field}; 472 473 # $recordType is a shorthand in the return statement for problem or set 474 # $recordID is a shorthand in the return statement for $problemID or $setID 475 my $recordType = ""; 476 my $recordID = ""; 477 if (defined $problemID) { 478 $recordType = "problem"; 479 $recordID = $problemID; 480 } else { 481 $recordType = "set"; 482 $recordID = $setID; 483 } 484 485 # $inputType contains either an input box or a popup_menu for changing a given db field 486 my $inputType = ""; 487 if ($edit) { 488 $inputType = CGI::input({ 489 name => "$recordType.$recordID.$field", 490 value => $r->param("$recordType.$recordID.$field") || ($forUsers ? $userValue : $globalValue), 491 size => $properties{size} || 5, 492 }); 493 } elsif ($choose) { 494 # Note that in popup menus, you're almost guaranteed to have the choices hashed to labels in %properties 495 # but $userValue and and $globalValue are the values in the hash not the keys 496 # so we have to use the actual db record field values to select our default here. 497 498 # FIXME: this allows us to set one selector from two (or more) fields 499 # if $field matches /:/, we have to get two fields to get the data we need here 500 my $value = $r->param("$recordType.$recordID.$field"); 501 if ( ! $value && $field =~ /:/ ) { 502 my @fields = split(/:/, $field); 503 $value = ''; 504 foreach my $f ( @fields ) { 505 $value .= ($forUsers && $userRecord->$f ne '' ? $userRecord->$f : $globalRecord->$f) . ":"; 506 } 507 $value =~ s/:$//; 508 } elsif ( ! $value ) { 509 $value = ($forUsers && $userRecord->$field ne '' ? $userRecord->$field : $globalRecord->$field); 510 } 511 512 $inputType = CGI::popup_menu({ 513 name => "$recordType.$recordID.$field", 514 values => $properties{choices}, 515 labels => \%labels, 516 default => $value, 517 }); 518 } 519 520 my $gDisplVal = defined($properties{labels}) && defined($properties{labels}->{$globalValue}) ? $properties{labels}->{$globalValue} : $globalValue; 521 522 # FIXME: adding ":" in the checked => allows for multiple fields to be set by one selector 523 # return (($forUsers && $edit && $check) ? CGI::checkbox({ 524 return (($forUsers && $check) ? CGI::checkbox({ 525 type => "checkbox", 526 name => "$recordType.$recordID.$field.override", 527 label => "", 528 value => $field, 529 checked => $r->param("$recordType.$recordID.$field.override") || ($userValue ne ($labels{""} || $blankfield) ? 1 : 0), 530 }) : "", 531 $properties{name}, 532 $inputType, 533 $forUsers ? " $gDisplVal" : "", 534 ); 535 } 536 537 # return weird fields that are non-native or which are displayed 538 # for only some sets 539 sub extraSetFields { 540 my ($self,$userID,$setID,$globalRecord,$userRecord,$forUsers) = @_; 541 my $db = $self->r->{db}; 542 543 my ($gwFields, $ipFields, $ipDefaults, $numLocations, $ipOverride, 544 $procFields) = ( '', '', '', 0, '', '' ); 545 546 # if we're dealing with a gateway, set up a table of gateway fields 547 my $nF = 0; # this is the number of columns in the set field table 548 if ( $globalRecord->assignment_type() =~ /gateway/ ) { 549 my $gwhdr = "\n<!-- begin gwoutput table -->\n"; 550 551 foreach my $gwfield ( @{ GATEWAY_SET_FIELD_ORDER() } ) { 552 553 my @fieldData = 554 ($self->FieldHTML($userID, $setID, undef, 555 $globalRecord, $userRecord, 556 $gwfield)); 557 if ( @fieldData && defined($fieldData[1]) and 558 $fieldData[1] ne '' ) { 559 $nF = @fieldData if ( @fieldData > $nF ); 560 $gwFields .= CGI::Tr({}, 561 CGI::td({}, [@fieldData])); 562 } 563 } 564 $gwhdr .= CGI::Tr({},CGI::td({colspan=>$nF}, 565 CGI::em("Gateway parameters"))) 566 if ( $nF ); 567 $gwFields = "$gwhdr$gwFields\n" . 568 "<!-- end gwoutput table -->\n"; 569 } 570 571 # if we have a proctored test, then also generate a proctored 572 # set password input 573 if ( $globalRecord->assignment_type eq 'proctored_gateway' && ! $forUsers ) { 574 my $nfm1 = $nF - 1; 575 $procFields = CGI::Tr({},CGI::td({},''), 576 CGI::td({colspan=>$nfm1}, 577 CGI::em("Proctored tests require proctor " . 578 "authorization to start and to " . 579 "grade. Provide a password to have " . 580 "a single password for all students " . 581 "to start a proctored test."))); 582 # we use a routine other than FieldHTML because of getting 583 # the default value here 584 my @fieldData = 585 $self->proctoredFieldHTML($userID, $setID, 586 $globalRecord); 587 $procFields .= CGI::Tr({}, 588 CGI::td({}, [@fieldData])); 589 } 590 591 # finally, figure out what ip selector fields we want to include 592 my @locations = sort {$a cmp $b} ($db->listLocations()); 593 $numLocations = @locations; 594 595 if ( ( ! $forUsers && $globalRecord->restrict_ip && 596 $globalRecord->restrict_ip ne 'No' ) || 597 ( $forUsers && $userRecord->restrict_ip ne 'No' ) ) { 598 599 my @globalLocations = $db->listGlobalSetLocations($setID); 600 # what ip locations should be selected? 601 my @defaultLocations = (); 602 if ( $forUsers && 603 ! $db->countUserSetLocations($userID, $setID) ) { 604 @defaultLocations = @globalLocations; 605 $ipOverride = 0; 606 } elsif ( $forUsers ) { 607 @defaultLocations = $db->listUserSetLocations($userID, $setID); 608 $ipOverride = 1; 609 } else { 610 @defaultLocations = @globalLocations; 611 } 612 my $ipDefaults = join(', ', @globalLocations); 613 614 my $ipSelector = CGI::scrolling_list({ 615 -name => "set.$setID.selected_ip_locations", 616 -values => [ @locations ], 617 -default => [ @defaultLocations ], 618 -size => 5, 619 -multiple => 'true'}); 620 621 my $override = ($forUsers) ? 622 CGI::checkbox({ type => "checkbox", 623 name => "set.$setID.selected_ip_locations.override", 624 label => "", 625 checked => $ipOverride }) : ''; 626 $ipFields .= CGI::Tr({-valign=>'top'}, 627 CGI::td({}, [ $override, 628 'Restrict Locations', 629 $ipSelector, 630 $forUsers ? 631 " $ipDefaults" : '', ] 632 ), 633 ); 634 } 635 return($gwFields, $ipFields, $numLocations, $procFields); 636 } 637 638 sub proctoredFieldHTML { 639 my ( $self, $userID, $setID, $globalRecord ) = @_; 640 641 my $r = $self->r; 642 my $db = $r->db; 643 644 # note that this routine assumes that the login proctor password 645 # is something that can only be changed for the global set 646 647 # if the set doesn't require a login proctor, then we can assume 648 # that one doesn't exist; otherwise, we need to check the 649 # database to find if there's an already defined password 650 my $value = ''; 651 if ( $globalRecord->restricted_login_proctor eq 'Yes' && 652 $db->existsPassword("set_id:$setID") ) { 653 $value = '********'; 654 } 655 656 return( ( '', 657 'Password (Leave blank for regular proctoring)', 658 CGI::input({ name=>"set.$setID.restricted_login_proctor_password", 659 value=>$value, 660 size=>10, 661 }), 662 '' ) ); 663 } 664 665 # creates a popup menu of all possible problem numbers (for possible rearranging) 666 sub problem_number_popup { 667 my $num = shift; 668 my $total = shift; 669 return (CGI::popup_menu(-name => "problem_num_$num", 670 -values => [1..$total], 671 -default => $num)); 672 } 673 674 # handles rearrangement necessary after changes to problem ordering 675 sub handle_problem_numbers { 676 my $newProblemNumbersref = shift; 677 my %newProblemNumbers = %$newProblemNumbersref; 678 my $maxNum = shift; 679 my $db = shift; 680 my $setID = shift; 681 my $force = shift || 0; 682 my @sortme=(); 683 my ($j, $val); 684 685 # keys are current problem numbers, values are target problem numbers 686 foreach $j (keys %newProblemNumbers) { 687 # we don't want to act unless all problems have been assigned a new problem number, so if any have not, return 688 return "" if (not defined $newProblemNumbers{"$j"}); 689 # if the problem has been given a new number, we reduce the "score" of the problem by the original number of the problem 690 # when multiple problems are assigned the same number, this results in the last one ending up first -- FIXME? 691 if ($newProblemNumbers{"$j"} != $j) { 692 # force always gets set if reordering is done, so don't expect to be able to delete a problem, 693 # reorder some other problems, and end up with a hole -- FIXME 694 $force = 1; 695 $val = 1000 * $newProblemNumbers{$j} - $j; 696 } else { 697 $val = 1000 * $newProblemNumbers{$j}; 698 } 699 # store a mapping between current problem number and score (based on currnet and new problem number) 700 push @sortme, [$j, $val]; 701 # replace new problem numbers in hash with the (global) problems themselves 702 $newProblemNumbers{$j} = $db->getGlobalProblem($setID, $j); 703 die "global $j for set $setID not found." unless $newProblemNumbers{$j}; 704 } 705 706 # we don't have to do anything if we're not getting rid of holes 707 return "" unless $force; 708 709 # sort the curr. prob. num./score pairs by score 710 @sortme = sort {$a->[1] <=> $b->[1]} @sortme; 711 # now, for global and each user with this set, loop through problem list 712 # get all of the problem records 713 # assign new problem numbers 714 # loop - if number is new, put the problem record 715 # print "Sorted to get ". join(', ', map {$_->[0] } @sortme) ."<p>\n"; 716 717 718 # Now, three stages. First global values 719 720 for ($j = 0; $j < scalar @sortme; $j++) { 721 if($sortme[$j][0] == $j + 1) { 722 # if the jth problem (according to the new ordering) is in the right place (problem IDs are numbered from 1, hence $j+1) 723 # do nothing 724 } elsif (not defined $newProblemNumbers{$j + 1}) { 725 # otherwise, if there's a hole for it, add it there 726 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 727 $db->addGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 728 } else { 729 # otherwise, overwrite the data for the problem that's already there with the jth problem's data (with a changed problemID) 730 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 731 $db->putGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 732 } 733 } 734 735 my @setUsers = $db->listSetUsers($setID); 736 my (@problist, $user); 737 738 foreach $user (@setUsers) { 739 # grab a copy of each UserProblem for this user. @problist can be sparse (if problems were deleted) 740 for $j (keys %newProblemNumbers) { 741 $problist[$j] = $db->getUserProblem($user, $setID, $j); 742 } 743 for($j = 0; $j < scalar @sortme; $j++) { 744 if ($sortme[$j][0] == $j + 1) { 745 # same as above -- the jth problem is in the right place, so don't worry about it 746 # do nothing 747 } elsif ($problist[$sortme[$j][0]]) { 748 # we've made sure the user's problem actually exists HERE, since we want to be able to fail gracefullly if it doesn't 749 # the problem with the original conditional below is that %newProblemNumbers maps oldids => global problem record 750 # we need to check if the target USER PROBLEM exists, which is what @problist knows 751 #if (not defined $newProblemNumbers{$j + 1}) { 752 if (not defined $problist[$j+1]) { 753 # same as above -- there's a hole for that problem to go into, so add it in its new place 754 $problist[$sortme[$j][0]]->problem_id($j + 1); 755 $db->addUserProblem($problist[$sortme[$j][0]]); 756 } else { 757 # same as above -- there's a problem already there, so overwrite its data with the data from the jth problem 758 $problist[$sortme[$j][0]]->problem_id($j + 1); 759 $db->putUserProblem($problist[$sortme[$j][0]]); 760 } 761 } else { 762 warn "UserProblem missing for user=$user set=$setID problem=$sortme[$j][0]. This may indicate database corruption.\n"; 763 # when a problem doesn't exist in the target slot, a new problem gets added there, but the original problem 764 # never gets overwritten (because there wan't a problem it would have to get exchanged with) 765 # 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: 766 # @sortme[$j][0] will contain: 4, 1, 2, 3 767 # - problem 1 will get **added** with the data from problem 4 (because problem 1 doesn't exist for this user) 768 # - problem 2 will get overwritten with the data from problem 1 769 # - problem 3 will get overwritten with the data from problem 2 770 # - nothing will happend to problem 4, since problem 1 doesn't exit 771 # so the solution is to delete problem 4 altogether! 772 # here's the fix: 773 774 # the data from problem $j+1 was/will be moved to another problem slot, 775 # but there's no problem $sortme[$j][0] to replace it. thus, we delete it now. 776 $db->deleteUserProblem($user, $setID, $j+1); 777 } 778 } 779 } 780 781 # any problems with IDs above $maxNum get deleted -- presumably their data has been copied into problems with lower IDs 782 foreach ($j = scalar @sortme; $j < $maxNum; $j++) { 783 if (defined $newProblemNumbers{$j + 1}) { 784 $db->deleteGlobalProblem($setID, $j+1); 785 } 786 } 787 788 # return a string form of the old problem IDs in the new order (not used by caller, incidentally) 789 return join(', ', map {$_->[0]} @sortme); 790 } 791 792 # swap index given with next bigger index 793 # leftover from when we had up/down buttons 794 # maybe we will bring them back 795 796 #sub moveme { 797 # my $index = shift; 798 # my $db = shift; 799 # my $setID = shift; 800 # my (@problemIDList) = @_; 801 # my ($prob1, $prob2, $prob); 802 # 803 # foreach my $problemID (@problemIDList) { 804 # my $problemRecord = $db->getGlobalProblem($setID, $problemID); # checked 805 # die "global $problemID for set $setID not found." unless $problemRecord; 806 # if ($problemRecord->problem_id == $index) { 807 # $prob1 = $problemRecord; 808 # } elsif ($problemRecord->problem_id == $index + 1) { 809 # $prob2 = $problemRecord; 810 # } 811 # } 812 # if (not defined $prob1 or not defined $prob2) { 813 # die "cannot find problem $index or " . ($index + 1); 814 # } 815 # 816 # $prob1->problem_id($index + 1); 817 # $prob2->problem_id($index); 818 # $db->putGlobalProblem($prob1); 819 # $db->putGlobalProblem($prob2); 820 # 821 # my @setUsers = $db->listSetUsers($setID); 822 # 823 # my $user; 824 # foreach $user (@setUsers) { 825 # $prob1 = $db->getUserProblem($user, $setID, $index); #checked 826 # die " problem $index for set $setID and effective user $user not found" 827 # unless $prob1; 828 # $prob2 = $db->getUserProblem($user, $setID, $index+1); #checked 829 # die " problem $index for set $setID and effective user $user not found" 830 # unless $prob2; 831 # $prob1->problem_id($index+1); 832 # $prob2->problem_id($index); 833 # $db->putUserProblem($prob1); 834 # $db->putUserProblem($prob2); 835 # } 836 #} 837 838 # primarily saves any changes into the correct set or problem records (global vs user) 839 # also deals with deleting or rearranging problems 840 sub initialize { 841 my ($self) = @_; 842 my $r = $self->r; 843 my $db = $r->db; 844 my $ce = $r->ce; 845 my $authz = $r->authz; 846 my $user = $r->param('user'); 847 my $setID = $r->urlpath->arg("setID"); 848 my $setRecord = $db->getGlobalSet($setID); # checked 849 die "global set $setID not found." unless $setRecord; 850 851 $self->{set} = $setRecord; 852 my @editForUser = $r->param('editForUser'); 853 # some useful booleans 854 my $forUsers = scalar(@editForUser); 855 my $forOneUser = $forUsers == 1; 856 857 # Check permissions 858 return unless ($authz->hasPermissions($user, "access_instructor_tools")); 859 return unless ($authz->hasPermissions($user, "modify_problem_sets")); 860 861 862 my %properties = %{ FIELD_PROPERTIES() }; 863 864 # takes a hash of hashes and inverts it 865 my %undoLabels; 866 foreach my $key (keys %properties) { 867 %{ $undoLabels{$key} } = map { $properties{$key}->{labels}->{$_} => $_ } keys %{ $properties{$key}->{labels} }; 868 } 869 870 # Unfortunately not everyone uses Javascript enabled browsers so 871 # we must fudge the information coming from the ComboBoxes 872 # Since the textfield and menu both have the same name, we get an array of two elements 873 # We then reset the param to the first if its not-empty or the second (empty or not). 874 foreach ( @{ HEADER_ORDER() } ) { 875 my @values = $r->param("set.$setID.$_"); 876 my $value = $values[0] || $values[1] || ""; 877 $r->param("set.$setID.$_", $value); 878 } 879 880 ##################################################################### 881 # Check date information 882 ##################################################################### 883 884 my ($open_date, $due_date, $answer_date); 885 my $error = 0; 886 if (defined $r->param('submit_changes')) { 887 my @names = ("open_date", "due_date", "answer_date"); 888 889 my %dates = map { $_ => $r->param("set.$setID.$_") } @names; 890 %dates = map { 891 my $unlabel = $undoLabels{$_}->{$dates{$_}}; 892 $_ => defined $unlabel ? $setRecord->$_ : $self->parseDateTime($dates{$_}) 893 } @names; 894 895 ($open_date, $due_date, $answer_date) = map { $dates{$_} } @names; 896 897 if ($answer_date < $due_date || $answer_date < $open_date) { 898 $self->addbadmessage("Answers cannot be made available until on or after the due date!"); 899 $error = $r->param('submit_changes'); 900 } 901 902 if ($due_date < $open_date) { 903 $self->addbadmessage("Answers cannot be due until on or after the open date!"); 904 $error = $r->param('submit_changes'); 905 } 906 907 # make sure the dates are not more than 10 years in the future 908 my $curr_time = time; 909 my $seconds_per_year = 31_556_926; 910 my $cutoff = $curr_time + $seconds_per_year*10; 911 if ($open_date > $cutoff) { 912 $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); 913 $error = $r->param('submit_changes'); 914 } 915 if ($due_date > $cutoff) { 916 $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); 917 $error = $r->param('submit_changes'); 918 } 919 if ($answer_date > $cutoff) { 920 $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); 921 $error = $r->param('submit_changes'); 922 } 923 924 } 925 if ($error) { 926 $self->addbadmessage("No changes were saved!"); 927 } 928 929 if (defined $r->param('submit_changes') && !$error) { 930 931 #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam 932 933 ##################################################################### 934 # Save general set information (including headers) 935 ##################################################################### 936 937 if ($forUsers) { 938 # note that we don't deal with the proctor user 939 # fields here, with the assumption that it can't 940 # be possible to change them for users. this is 941 # not the most robust treatment of the problem 942 # (FIXME) 943 944 # DBFIXME use a WHERE clause, iterator 945 my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser); 946 foreach my $record (@userRecords) { 947 foreach my $field ( @{ SET_FIELDS() } ) { 948 next unless canChange($forUsers, $field); 949 my $override = $r->param("set.$setID.$field.override"); 950 951 if (defined $override && $override eq $field) { 952 953 my $param = $r->param("set.$setID.$field"); 954 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 955 my $unlabel = $undoLabels{$field}->{$param}; 956 $param = $unlabel if defined $unlabel; 957 # $param = $undoLabels{$field}->{$param} || $param; 958 if ($field =~ /_date/) { 959 $param = $self->parseDateTime($param) unless defined $unlabel; 960 } 961 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { 962 $param = $param*$properties{$field}->{convertby}; 963 } 964 # special case; does field fill in multiple values? 965 if ( $field =~ /:/ ) { 966 my @values = split(/:/, $param); 967 my @fields = split(/:/, $field); 968 for ( my $i=0; $i<@values; $i++ ) { 969 my $f=$fields[$i]; 970 $record->$f($values[$i]); 971 } 972 } else { 973 $record->$field($param); 974 } 975 } else { 976 #################### 977 # FIXME: allow one selector to set multiple fields 978 # 979 if ( $field =~ /:/ ) { 980 foreach my $f ( split(/:/, $field) ) { 981 $record->$f(undef); 982 } 983 } else { 984 $record->$field(undef); 985 } 986 } 987 988 } 989 #################### 990 # FIXME: this is replaced by our allowing multiple fields to be set by one selector 991 # a check for hiding scores: if we have 992 # $set->hide_score eq 'N', we also want 993 # $set->hide_score_by_problem eq 'N' 994 # if ( $record->hide_score eq 'N' ) { 995 # $record->hide_score_by_problem('N'); 996 # } 997 #################### 998 $db->putUserSet($record); 999 } 1000 1001 ####################################################### 1002 # Save IP restriction Location information 1003 ####################################################### 1004 # FIXME: it would be nice to have this in the field values 1005 # hash, so that we don't have to assume that we can 1006 # override this information for users 1007 1008 if ( $r->param("set.$setID.selected_ip_locations.override") ) { 1009 foreach my $record ( @userRecords ) { 1010 my $userID = $record->user_id; 1011 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1012 my @userSetLocations = $db->listUserSetLocations($userID,$setID); 1013 my @addSetLocations = (); 1014 my @delSetLocations = (); 1015 foreach my $loc ( @selectedLocations ) { 1016 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) ); 1017 } 1018 foreach my $loc ( @userSetLocations ) { 1019 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1020 } 1021 # then update the user set_locations 1022 foreach ( @addSetLocations ) { 1023 my $Loc = $db->newUserSetLocation; 1024 $Loc->set_id( $setID ); 1025 $Loc->user_id( $userID ); 1026 $Loc->location_id($_); 1027 $db->addUserSetLocation($Loc); 1028 } 1029 foreach ( @delSetLocations ) { 1030 $db->deleteUserSetLocation($userID,$setID,$_); 1031 } 1032 } 1033 } else { 1034 # if override isn't selected, then we want 1035 # to be sure that there are no 1036 # set_locations_user entries setting around 1037 foreach my $record ( @userRecords ) { 1038 my $userID = $record->user_id; 1039 my @userLocations = $db->listUserSetLocations($userID,$setID); 1040 foreach ( @userLocations ) { 1041 $db->deleteUserSetLocation($userID,$setID,$_); 1042 } 1043 } 1044 } 1045 } else { 1046 foreach my $field ( @{ SET_FIELDS() } ) { 1047 next unless canChange($forUsers, $field); 1048 1049 my $param = $r->param("set.$setID.$field"); 1050 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1051 1052 my $unlabel = $undoLabels{$field}->{$param}; 1053 $param = $unlabel if defined $unlabel; 1054 if ($field =~ /_date/) { 1055 $param = $self->parseDateTime($param) unless defined $unlabel; 1056 } 1057 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { 1058 $param = $param*$properties{$field}->{convertby}; 1059 } 1060 # special case; does field fill in multiple values? 1061 if ( $field =~ /:/ ) { 1062 my @values = split(/:/, $param); 1063 my @fields = split(/:/, $field); 1064 for ( my $i=0; $i<@fields; $i++ ) { 1065 my $f = $fields[$i]; 1066 $setRecord->$f($values[$i]); 1067 } 1068 } else { 1069 $setRecord->$field($param); 1070 } 1071 } 1072 #################### 1073 # FIXME: this is replaced by our setting both hide_score and hide_score_by_problem 1074 # with a single drop down 1075 # 1076 # # a check for hiding scores: if we have 1077 # # $set->hide_score eq 'N', we also want 1078 # # $set->hide_score_by_problem eq 'N', and if it's 1079 # # changed to 'Y' and hide_score_by_problem is Null, 1080 # # give it a value 'N' 1081 # if ( $setRecord->hide_score eq 'N' || 1082 # ( ! defined($setRecord->hide_score_by_problem) || 1083 # $setRecord->hide_score_by_problem eq '' ) ) { 1084 # $setRecord->hide_score_by_problem('N'); 1085 # } 1086 #################### 1087 $db->putGlobalSet($setRecord); 1088 1089 ####################################################### 1090 # Save IP restriction Location information 1091 ####################################################### 1092 1093 if ( $r->param("set.$setID.restrict_ip") ne 'No' ) { 1094 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1095 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1096 my @addSetLocations = (); 1097 my @delSetLocations = (); 1098 foreach my $loc ( @selectedLocations ) { 1099 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @globalSetLocations ) ); 1100 } 1101 foreach my $loc ( @globalSetLocations ) { 1102 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1103 } 1104 # then update the global set_locations 1105 foreach ( @addSetLocations ) { 1106 my $Loc = $db->newGlobalSetLocation; 1107 $Loc->set_id( $setID ); 1108 $Loc->location_id($_); 1109 $db->addGlobalSetLocation($Loc); 1110 } 1111 foreach ( @delSetLocations ) { 1112 $db->deleteGlobalSetLocation($setID,$_); 1113 } 1114 } else { 1115 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1116 foreach ( @globalSetLocations ) { 1117 $db->deleteGlobalSetLocation($setID,$_); 1118 } 1119 } 1120 1121 ####################################################### 1122 # Save proctored problem proctor user information 1123 ####################################################### 1124 if ($r->param("set.$setID.restricted_login_proctor_password") && 1125 $setRecord->assignment_type eq 'proctored_gateway') { 1126 # in this case we're adding a set-level proctor 1127 # or updating the password 1128 1129 my $procID = "set_id:$setID"; 1130 my $pass = $r->param("set.$setID.restricted_login_proctor_password"); 1131 # should we carefully check in this case that 1132 # the user and password exist? the code 1133 # in the add stanza is pretty careful to 1134 # be sure that there's a one-to-one 1135 # correspondence between the existence of 1136 # the user and the setting of the set 1137 # restricted_login_proctor field, so we 1138 # assume that just checking the latter 1139 # here is sufficient. 1140 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1141 # in this case we already have a set 1142 # level proctor, and so should be 1143 # resetting the password 1144 if ( $pass ne '********' ) { 1145 # then we submitted a new 1146 # password, so save it 1147 my $dbPass; 1148 eval { $dbPass = $db->getPassword($procID) }; 1149 if ( $@ ) { 1150 $self->addbadmessage("Error getting old set-proctor password from the database: $@. No update to the password was done."); 1151 } else { 1152 $dbPass->password(cryptPassword($pass)); 1153 $db->putPassword($dbPass); 1154 } 1155 } 1156 1157 } else { 1158 $setRecord->restricted_login_proctor('Yes'); 1159 my $procUser = $db->newUser(); 1160 $procUser->user_id($procID); 1161 $procUser->last_name("Proctor"); 1162 $procUser->first_name("Login"); 1163 $procUser->student_id("loginproctor"); 1164 $procUser->status($ce->status_name_to_abbrevs('Proctor')); 1165 my $procPerm = $db->newPermissionLevel; 1166 $procPerm->user_id($procID); 1167 $procPerm->permission($ce->{userRoles}->{login_proctor}); 1168 my $procPass = $db->newPassword; 1169 $procPass->user_id($procID); 1170 $procPass->password(cryptPassword($pass)); 1171 # put these into the database 1172 eval { $db->addUser($procUser) }; 1173 if ( $@ ) { 1174 $self->addbadmessage("Error " . 1175 "adding set-level " . 1176 "proctor: $@"); 1177 } else { 1178 $db->addPermissionLevel($procPerm); 1179 $db->addPassword($procPass); 1180 } 1181 1182 # and set the restricted_login_proctor 1183 # set field 1184 $db->putGlobalSet( $setRecord ); 1185 } 1186 1187 } else { 1188 # if the parameter isn't set, or if the assignment 1189 # type is not 'proctored_gateway', then we need to be 1190 # sure that there's no set-level proctor defined 1191 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1192 1193 $setRecord->restricted_login_proctor('No'); 1194 $db->deleteUser( "set_id:$setID" ); 1195 $db->putGlobalSet( $setRecord ); 1196 1197 } 1198 } 1199 } 1200 1201 ##################################################################### 1202 # Save problem information 1203 ##################################################################### 1204 1205 # DBFIXME use a WHERE clause, iterator? 1206 my @problemIDs = sort { $a <=> $b } $db->listGlobalProblems($setID);; 1207 my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); 1208 foreach my $problemRecord (@problemRecords) { 1209 my $problemID = $problemRecord->problem_id; 1210 die "Global problem $problemID for set $setID not found." unless $problemRecord; 1211 1212 if ($forUsers) { 1213 # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page 1214 # So we only need to make changes to the UserProblem record and only then if we are overriding a value 1215 # in the GlobalProblem record or for fields unique to the UserProblem record. 1216 1217 my @userIDs = @editForUser; 1218 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1219 # DBFIXME where clause? iterator? 1220 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1221 foreach my $record (@userProblemRecords) { 1222 1223 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1224 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1225 next unless canChange($forUsers, $field); 1226 1227 my $override = $r->param("problem.$problemID.$field.override"); 1228 if (defined $override && $override eq $field) { 1229 1230 my $param = $r->param("problem.$problemID.$field"); 1231 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1232 my $unlabel = $undoLabels{$field}->{$param}; 1233 $param = $unlabel if defined $unlabel; 1234 $changed ||= changed($record->$field, $param); 1235 $record->$field($param); 1236 } else { 1237 $changed ||= changed($record->$field, undef); 1238 $record->$field(undef); 1239 } 1240 1241 } 1242 1243 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1244 next unless canChange($forUsers, $field); 1245 1246 my $param = $r->param("problem.$problemID.$field"); 1247 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1248 my $unlabel = $undoLabels{$field}->{$param}; 1249 $param = $unlabel if defined $unlabel; 1250 $changed ||= changed($record->$field, $param); 1251 $record->$field($param); 1252 } 1253 $db->putUserProblem($record) if $changed; 1254 } 1255 } else { 1256 # Since we're editing for ALL set users, we will make changes to the GlobalProblem record. 1257 # We may also have instances where a field is unique to the UserProblem record but we want 1258 # all users to (at least initially) have the same value 1259 1260 # this only edits a globalProblem record 1261 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1262 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1263 next unless canChange($forUsers, $field); 1264 1265 my $param = $r->param("problem.$problemID.$field"); 1266 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1267 my $unlabel = $undoLabels{$field}->{$param}; 1268 $param = $unlabel if defined $unlabel; 1269 $changed ||= changed($problemRecord->$field, $param); 1270 $problemRecord->$field($param); 1271 } 1272 $db->putGlobalProblem($problemRecord) if $changed; 1273 1274 1275 # sometimes (like for status) we might want to change an attribute in 1276 # the userProblem record for every assigned user 1277 # However, since this data is stored in the UserProblem records, 1278 # it won't be displayed once its been changed and if you hit "Save Changes" again 1279 # it gets erased 1280 1281 # So we'll enforce that there be something worth putting in all the UserProblem records 1282 # This also will make hitting "Save Changes" on the global page MUCH faster 1283 my %useful; 1284 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1285 my $param = $r->param("problem.$problemID.$field"); 1286 $useful{$field} = 1 if defined $param and $param ne ""; 1287 } 1288 1289 if (keys %useful) { 1290 # DBFIXME where clause, iterator 1291 my @userIDs = $db->listProblemUsers($setID, $problemID); 1292 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1293 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1294 foreach my $record (@userProblemRecords) { 1295 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1296 foreach my $field ( keys %useful ) { 1297 next unless canChange($forUsers, $field); 1298 1299 my $param = $r->param("problem.$problemID.$field"); 1300 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1301 my $unlabel = $undoLabels{$field}->{$param}; 1302 $param = $unlabel if defined $unlabel; 1303 $changed ||= changed($record->$field, $param); 1304 $record->$field($param); 1305 } 1306 $db->putUserProblem($record) if $changed; 1307 } 1308 } 1309 } 1310 } 1311 1312 # Mark the specified problems as correct for all users 1313 foreach my $problemID ($r->param('markCorrect')) { 1314 # DBFIXME where clause, iterator 1315 my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID)); 1316 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1317 foreach my $record (@userProblemRecords) { 1318 if (defined $record && ($record->status eq "" || $record->status < 1)) { 1319 $record->status(1); 1320 $record->attempted(1); 1321 $db->putUserProblem($record); 1322 } 1323 } 1324 } 1325 1326 # Delete all problems marked for deletion 1327 foreach my $problemID ($r->param('deleteProblem')) { 1328 $db->deleteGlobalProblem($setID, $problemID); 1329 } 1330 1331 ##################################################################### 1332 # Add blank problem if needed 1333 ##################################################################### 1334 if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { 1335 my $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setID)); 1336 ################################################## 1337 # make local copy of the blankProblem 1338 ################################################## 1339 my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; 1340 my $problemContents = WeBWorK::Utils::readFile($blank_file_path); 1341 my $new_file_path = "set$setID/".BLANKPROBLEM(); 1342 my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); 1343 local(*TEMPFILE); 1344 open(TEMPFILE, ">$fullPath") or warn "Can't write to file $fullPath"; 1345 print TEMPFILE $problemContents; 1346 close(TEMPFILE); 1347 1348 ################################################# 1349 # Update problem record 1350 ################################################# 1351 my $problemRecord = $self->addProblemToSet( 1352 setName => $setID, 1353 sourceFile => $new_file_path, 1354 problemID => $targetProblemNumber, #added to end of set 1355 ); 1356 $self->assignProblemToAllSetUsers($problemRecord); 1357 $self->addgoodmessage("Added $new_file_path to ". $setID. " as problem $targetProblemNumber") ; 1358 } 1359 1360 # Sets the specified header to "" so that the default file will get used. 1361 foreach my $header ($r->param('defaultHeader')) { 1362 $setRecord->$header(""); 1363 } 1364 } 1365 1366 # Leftover code from when there were up/down buttons 1367 1368 # } else { 1369 # # Look for up and down buttons 1370 # my $index = 2; 1371 # while ($index <= scalar @problemList) { 1372 # if (defined $r->param("move.up.$index.x")) { 1373 # moveme($index-1, $db, $setID, @problemList); 1374 # } 1375 # $index++; 1376 # } 1377 # $index = 1; 1378 # 1379 # while ($index < scalar @problemList) { 1380 # if (defined $r->param("move.down.$index.x")) { 1381 # moveme($index, $db, $setID, @problemList); 1382 # } 1383 # $index++; 1384 # } 1385 # } 1386 1387 1388 # This erases any sticky fields if the user saves changes, resets the form, or reorders problems 1389 # It may not be obvious why this is necessary when saving changes or reordering problems 1390 # but when the problems are reorder the param problem.1.source_file needs to be the source 1391 # file of the problem that is NOW #1 and not the problem that WAS #1. 1392 unless (defined $r->param('refresh')) { 1393 1394 # reset all the parameters dealing with set/problem/header information 1395 # if the current naming scheme is changed/broken, this could reek havoc 1396 # on all kinds of things 1397 foreach my $param ($r->param) { 1398 $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; 1399 } 1400 } 1401 } 1402 1403 # helper method for debugging 1404 sub definedness ($) { 1405 my ($variable) = @_; 1406 1407 return "undefined" unless defined $variable; 1408 return "empty" unless $variable ne ""; 1409 return $variable; 1410 } 1411 1412 # helper method for checking if two things are different 1413 # the return values will usually be thrown away, but they could be useful for debugging 1414 sub changed ($$) { 1415 my ($first, $second) = @_; 1416 1417 return "def/undef" if defined $first and not defined $second; 1418 return "undef/def" if not defined $first and defined $second; 1419 return "" if not defined $first and not defined $second; 1420 return "ne" if $first ne $second; 1421 return ""; # if they're equal, there's no change 1422 } 1423 1424 # helper method that determines for how many users at a time a field can be changed 1425 # none means it can't be changed for anyone 1426 # any means it can be changed for anyone 1427 # one means it can ONLY be changed for one at a time. (eg problem_seed) 1428 # all means it can ONLY be changed for all at a time. (eg set_header) 1429 sub canChange ($$) { 1430 my ($forUsers, $field) = @_; 1431 1432 my %properties = %{ FIELD_PROPERTIES() }; 1433 my $forOneUser = $forUsers == 1; 1434 1435 my $howManyCan = $properties{$field}->{override}; 1436 1437 return 0 if $howManyCan eq "none"; 1438 return 1 if $howManyCan eq "any"; 1439 return 1 if $howManyCan eq "one" && $forOneUser; 1440 return 1 if $howManyCan eq "all" && !$forUsers; 1441 return 0; # FIXME: maybe it should default to 1? 1442 } 1443 1444 # helper method that determines if a file is valid and returns a pretty error message 1445 sub checkFile ($) { 1446 my ($self, $file) = @_; 1447 1448 my $r = $self->r; 1449 my $ce = $r->ce; 1450 1451 return "No source file specified" unless $file; 1452 $file = $ce->{courseDirs}->{templates} . '/' . $file unless $file =~ m|^/|; 1453 1454 my $text = "This source file "; 1455 my $fileError; 1456 return "" if -e $file && -f $file && -r $file; 1457 return $text . "is not readable!" if -e $file && -f $file; 1458 return $text . "is a directory!" if -d $file; 1459 return $text . "does not exist!" unless -e $file; 1460 return $text . "is not a plain file!"; 1461 } 1462 1463 # don't show view options -- we provide display mode controls for headers/problems separately 1464 sub options { 1465 return ""; 1466 } 1467 1468 # Creates two separate tables, first of the headers, and the of the problems in a given set 1469 # If one or more users are specified in the "editForUser" param, only the data for those users 1470 # becomes editable, not all the data 1471 sub body { 1472 1473 my ($self) = @_; 1474 my $r = $self->r; 1475 my $db = $r->db; 1476 my $ce = $r->ce; 1477 my $authz = $r->authz; 1478 my $userID = $r->param('user'); 1479 my $urlpath = $r->urlpath; 1480 my $courseID = $urlpath->arg("courseID"); 1481 my $setID = $urlpath->arg("setID"); 1482 my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; 1483 1484 my $userRecord = $db->getUser($userID) or die "No record for user $userID."; 1485 # Check permissions 1486 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 1487 unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); 1488 1489 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") 1490 unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); 1491 1492 my @editForUser = $r->param('editForUser'); 1493 1494 # Check that every user that we're editing for has a valid UserSet 1495 my @assignedUsers; 1496 my @unassignedUsers; 1497 if (scalar @editForUser) { 1498 foreach my $ID (@editForUser) { 1499 # DBFIXME iterator 1500 if ($db->getUserSet($ID, $setID)) { 1501 unshift @assignedUsers, $ID; 1502 } else { 1503 unshift @unassignedUsers, $ID; 1504 } 1505 } 1506 @editForUser = sort @assignedUsers; 1507 $r->param("editForUser", \@editForUser); 1508 1509 if (scalar @editForUser && scalar @unassignedUsers) { 1510 print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); 1511 } elsif (scalar @editForUser == 0) { 1512 print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); 1513 print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); 1514 } 1515 } 1516 1517 # some useful booleans 1518 my $forUsers = scalar(@editForUser); 1519 my $forOneUser = $forUsers == 1; 1520 1521 # If you're editing for users, initially their records will be different but 1522 # if you make any changes to them they will be the same. 1523 # if you're editing for one user, the problems shown should be his/hers 1524 my $userToShow = $forUsers ? $editForUser[0] : $userID; 1525 1526 # DBFIXME no need to get ID lists -- counts would be fine 1527 my $userCount = $db->listUsers(); 1528 my $setCount = $db->listGlobalSets(); # if $forOneUser; 1529 my $setUserCount = $db->countSetUsers($setID); 1530 my $userSetCount = $db->countUserSets($editForUser[0]) if $forOneUser; 1531 1532 1533 my $editUsersAssignedToSetURL = $self->systemLink( 1534 $urlpath->newFromModule( 1535 "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", 1536 courseID => $courseID, setID => $setID)); 1537 my $editSetsAssignedToUserURL = $self->systemLink( 1538 $urlpath->newFromModule( 1539 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1540 courseID => $courseID, userID => $editForUser[0])) if $forOneUser; 1541 1542 1543 my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); 1544 my $setDetailURL = $self->systemLink($setDetailPage, authen=>0); 1545 1546 1547 my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); 1548 my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; 1549 1550 $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; 1551 $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; 1552 1553 if ($forUsers) { 1554 ############################################## 1555 # calculate links for the users being edited: 1556 ############################################## 1557 my @userLinks = (); 1558 foreach my $userID (@editForUser) { 1559 my $u = $db->getUser($userID); 1560 my $email_address = $u->email_address; 1561 my $line = $u->last_name.", ".$u->first_name." (".CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id."). Assigned to "; 1562 my $editSetsAssignedToUserURL = $self->systemLink( 1563 $urlpath->newFromModule( 1564 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1565 courseID => $courseID, userID => $u->user_id)); 1566 $line .= CGI::a({href=>$editSetsAssignedToUserURL}, 1567 $self->setCountMessage($db->countUserSets($u->user_id), $setCount)); 1568 unshift @userLinks,$line; 1569 } 1570 @userLinks = sort @userLinks; 1571 1572 print CGI::table({border=>2,cellpadding=>10}, 1573 CGI::Tr({}, 1574 CGI::td([ 1575 "Editing problem set ".CGI::strong($setID)." data for these individual students:".CGI::br(). 1576 CGI::strong(join CGI::br(), @userLinks), 1577 CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set."), 1578 1579 ]) 1580 ) 1581 ); 1582 } else { 1583 print CGI::table({border=>2,cellpadding=>10}, 1584 CGI::Tr({}, 1585 CGI::td([ 1586 "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 1587 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", 1588 1589 ]) 1590 ) 1591 ); 1592 } 1593 1594 # handle renumbering of problems if necessary 1595 print CGI::a({name=>"problems"}); 1596 1597 my %newProblemNumbers = (); 1598 my $maxProblemNumber = -1; 1599 for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { 1600 $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); 1601 $maxProblemNumber = $jj if $jj > $maxProblemNumber; 1602 } 1603 1604 my $forceRenumber = $r->param('force_renumber') || 0; 1605 handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); 1606 1607 my %properties = %{ FIELD_PROPERTIES() }; 1608 1609 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1610 my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; 1611 push @active_modes, 'None'; 1612 my $default_header_mode = $r->param('header.displaymode') || 'None'; 1613 my $default_problem_mode = $r->param('problem.displaymode') || 'None'; 1614 1615 ##################################################################### 1616 # Browse available header/problem files 1617 ##################################################################### 1618 1619 my $templates = $r->ce->{courseDirs}->{templates}; 1620 my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); 1621 1622 my @headerFileList = listFilesRecursive( 1623 $templates, 1624 qr/header.*\.pg$/i, # match these files 1625 qr/^(?:$skip|CVS)$/, # prune these directories 1626 0, # match against file name only 1627 1, # prune against path relative to $templates 1628 ); 1629 1630 # this just takes too much time to search 1631 # my @problemFileList = listFilesRecursive( 1632 # $templates, 1633 # qr/\.pg$/i, # problem files don't say problem 1634 # qr/^(?:$skip|CVS)$/, # prune these directories 1635 # 0, # match against file name only 1636 # 1, # prune against path relative to $templates 1637 # ); 1638 1639 # Display a useful warning message 1640 if ($forUsers) { 1641 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . 1642 ($forOneUser ? "" : "s") . " listed above.")); 1643 } else { 1644 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); 1645 } 1646 1647 print CGI::start_form({method=>"POST", action=>$setDetailURL}); 1648 print $self->hiddenEditForUserFields(@editForUser); 1649 print $self->hidden_authen_fields; 1650 print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); 1651 print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); 1652 1653 # spacing 1654 print CGI::p(); 1655 1656 ##################################################################### 1657 # Display general set information 1658 ##################################################################### 1659 1660 print CGI::start_table({border=>1, cellpadding=>4}); 1661 print CGI::Tr({}, CGI::th({}, [ 1662 "General Information", 1663 ])); 1664 1665 # this is kind of a hack -- we need to get a user record here, so we can 1666 # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so 1667 # FieldHTML doesn't have to fetch it itself. 1668 my $userSetRecord = $db->getUserSet($userToShow, $setID); 1669 1670 print CGI::Tr({}, CGI::td({}, [ 1671 $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), 1672 ])); 1673 print CGI::end_table(); 1674 1675 # spacing 1676 print CGI::p(); 1677 1678 1679 ##################################################################### 1680 # Display header information 1681 ##################################################################### 1682 my @headers = @{ HEADER_ORDER() }; 1683 my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); 1684 my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); 1685 my @headerFiles = map { $setRecord->{$_} } @headers; 1686 if (scalar @headers and not $forUsers) { 1687 1688 print CGI::start_table({border=>1, cellpadding=>4}); 1689 print CGI::Tr({}, CGI::th({}, [ 1690 "Headers", 1691 # "Data", 1692 "Display Mode: " . 1693 CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. 1694 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1695 ])); 1696 1697 my %header_html; 1698 1699 my %error; 1700 foreach my $header (@headers) { 1701 my $headerFile = $r->param("set.$setID.$header") || $setRecord->{$header} || $headerDefaults{$header}; 1702 1703 $error{$header} = $self->checkFile($headerFile); 1704 my $this_set = $db->getMergedSet($userToShow, $setID); 1705 unless ($error{$header}) { 1706 my @temp = renderProblems( 1707 r=> $r, 1708 user => $db->getUser($userToShow), 1709 displayMode=> $default_header_mode, 1710 problem_number=> 0, 1711 this_set => $this_set, 1712 problem_list => [$headerFile], 1713 ); 1714 $header_html{$header} = $temp[0]; 1715 } 1716 } 1717 1718 foreach my $header (@headers) { 1719 1720 my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); 1721 my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $header, make_local_copy => 1 }); 1722 1723 my $viewHeaderPage = $urlpath->new(type => $headerModules{$header}, args => { courseID => $courseID, setID => $setID }); 1724 my $viewHeaderLink = $self->systemLink($viewHeaderPage); 1725 1726 print CGI::Tr({}, CGI::td({}, [ 1727 CGI::start_table({border => 0, cellpadding => 0}) . 1728 CGI::Tr({}, CGI::td({}, $properties{$header}->{name})) . 1729 CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . 1730 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . 1731 # CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "defaultHeader", value => $header, label => "Use Default"}))) . 1732 CGI::end_table(), 1733 # "", 1734 # CGI::input({ name => "set.$setID.$header", value => $setRecord->{$header}, size => 50}) . 1735 # join ("\n", $self->FieldHTML($userToShow, $setID, $problemID, "source_file")) . 1736 # CGI::br() . CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}), 1737 1738 comboBox({ 1739 name => "set.$setID.$header", 1740 request => $r, 1741 default => $r->param("set.$setID.$header") || $setRecord->{$header}, 1742 multiple => 0, 1743 values => ["", @headerFileList], 1744 labels => { "" => "Use Default Header File" }, 1745 }) . 1746 ($error{$header} ? 1747 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$header}) 1748 : CGI::div({class=> "RenderSolo"}, $header_html{$header}->{body_text}) 1749 ), 1750 ])); 1751 } 1752 1753 print CGI::end_table(); 1754 } else { 1755 print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); 1756 } 1757 1758 # spacing 1759 print CGI::p(); 1760 1761 1762 ##################################################################### 1763 # Display problem information 1764 ##################################################################### 1765 1766 my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); 1767 1768 # DBFIXME use iterators instead of getting all at once 1769 1770 # get global problem records for all problems in one go 1771 my %GlobalProblems; 1772 my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; 1773 # DBFIXME shouldn't need to get key list here 1774 @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); 1775 1776 # if needed, get user problem records for all problems in one go 1777 my (%UserProblems, %MergedProblems); 1778 if ($forOneUser) { 1779 my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; 1780 # DBFIXME shouldn't need to get key list here 1781 @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); 1782 @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); 1783 } 1784 1785 if (scalar @problemIDList) { 1786 1787 print CGI::start_table({border=>1, cellpadding=>4}); 1788 print CGI::Tr({}, CGI::th({}, [ 1789 "Problems", 1790 "Data", 1791 "Display Mode: " . 1792 CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. 1793 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1794 ])); 1795 1796 my %shownYet; 1797 my $repeatFile; 1798 foreach my $problemID (@problemIDList) { 1799 1800 my $problemRecord; 1801 if ($forOneUser) { 1802 #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); 1803 $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam 1804 } else { 1805 #$problemRecord = $db->getGlobalProblem($setID, $problemID); 1806 $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam 1807 } 1808 1809 #$self->addgoodmessage(""); 1810 #$self->addbadmessage($problemRecord->toString()); 1811 1812 1813 my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1814 my $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 1815 1816 1817 # FIXME: should we have an "act as" type link here when editing for multiple users? 1818 my $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1819 my $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); 1820 1821 my @fields = @{ PROBLEM_FIELDS() }; 1822 push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser; 1823 1824 my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; 1825 1826 # warn of repeat problems 1827 if (defined $shownYet{$problemFile}) { 1828 $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; 1829 } else { 1830 $shownYet{$problemFile} = $problemID; 1831 $repeatFile = ""; 1832 } 1833 1834 my $error = $self->checkFile($problemFile); 1835 my $this_set = $db->getMergedSet($userToShow, $setID); 1836 my @problem_html; 1837 unless ($error) { 1838 @problem_html = renderProblems( 1839 r=> $r, 1840 user => $db->getUser($userToShow), 1841 displayMode=> $default_problem_mode, 1842 problem_number=> $problemID, 1843 this_set => $this_set, 1844 problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, 1845 problem_list => [$problemRecord->source_file], 1846 ); 1847 } 1848 1849 print CGI::Tr({}, CGI::td({}, [ 1850 CGI::start_table({border => 0, cellpadding => 1}) . 1851 CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . 1852 CGI::Tr({}, CGI::td({}, CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it"))) . 1853 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")))) . 1854 ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . 1855 # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . 1856 ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . 1857 CGI::end_table(), 1858 $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}), 1859 # A comprehensive list of problems is just TOO big to be handled well 1860 # comboBox({ 1861 # name => "set.$setID.$problemID", 1862 # request => $r, 1863 # default => $problemRecord->{problem_id}, 1864 # multiple => 0, 1865 # values => \@problemFileList, 1866 # }) . 1867 1868 join ("\n", $self->FieldHTML( 1869 $userToShow, 1870 $setID, 1871 $problemID, 1872 $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam 1873 $UserProblems{$problemID}, # pass previously fetched user record to FieldHTML --sam 1874 "source_file" 1875 )) . 1876 CGI::br() . 1877 ($error ? 1878 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) 1879 : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) 1880 ) . 1881 ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), 1882 ])); 1883 } 1884 1885 1886 # print final lines 1887 print CGI::end_table(); 1888 print CGI::checkbox({ 1889 label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", 1890 name=>"force_renumber", value=>"1"}); 1891 print CGI::p(<<EOF); 1892 Any time problem numbers are intentionally changed, the problems will 1893 always be renumbered consecutively, starting from one. When deleting 1894 problems, gaps will be left in the numbering unless the box above is 1895 checked. 1896 EOF 1897 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()); 1898 print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); 1899 1900 } else { 1901 print CGI::p(CGI::b("This set doesn't contain any problems yet.")); 1902 } 1903 # always allow one to add a new problem. 1904 print CGI::checkbox({ 1905 label=> "Add blank problem template to end of homework set", 1906 name=>"add_blank_problem", value=>"1"} 1907 ),CGI::br(),CGI::br(), 1908 CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), 1909 CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), 1910 "(Any unsaved changes will be lost.)" 1911 ; 1912 1913 1914 1915 #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); 1916 #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); 1917 # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME 1918 #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); 1919 1920 print CGI::end_form(); 1921 1922 return ""; 1923 } 1924 1925 1; 1926 1927 =head1 AUTHOR 1928 1929 Written by Robert Van Dam, toenail (at) cif.rochester.edu 1930 1931 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |