Parent Directory
| 
Revision Log
backport (gage): Allow several blank problems to be added at once to a set.
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 my @gVals = (); 438 my @uVals = (); 439 my @bVals = (); 440 foreach my $f ( split(/:/, $field) ) { 441 # hmm. this directly references the data in the 442 # record rather than calling the access method, 443 # thereby avoiding errors if the userRecord is 444 # undefined. that seems a bit suspect, but it's 445 # used below so we'll leave it here. 446 447 push(@gVals, $globalRecord->{$f} ); 448 push(@uVals, $userRecord->{$f} ); # (defined($userRecord->{$f})?$userRecord->{$f}:'') ); 449 push(@bVals, ''); 450 } 451 # I don't like this, but combining multiple values is a bit messy 452 $globalValue = (grep {defined($_)} @gVals) ? join(':', (map { defined($_) ? $_ : '' } @gVals )) : undef; 453 $userValue = (grep {defined($_)} @uVals) ? join(':', (map { defined($_) ? $_ : '' } @uVals )) : undef; 454 $blankfield = join(':', @bVals); 455 } else { 456 $globalValue = $globalRecord->{$field}; 457 $userValue = $userRecord->{$field}; 458 } 459 460 # use defined instead of value in order to allow 0 to printed, e.g. for the 'value' field 461 $globalValue = (defined($globalValue)) ? ($labels{$globalValue || ""} || $globalValue) : ""; 462 $userValue = (defined($userValue)) ? ($labels{$userValue || ""} || $userValue) : $blankfield; 463 464 if ($field =~ /_date/) { 465 $globalValue = $self->formatDateTime($globalValue) if defined $globalValue && $globalValue ne $labels{""}; 466 $userValue = $self->formatDateTime($userValue) if defined $userValue && $userValue ne $labels{""}; 467 } 468 469 if ( defined($properties{convertby}) && $properties{convertby} ) { 470 $globalValue = $globalValue/$properties{convertby} if $globalValue; 471 $userValue = $userValue/$properties{convertby} if $userValue; 472 } 473 474 # check to make sure that a given value can be overridden 475 my %canOverride = map { $_ => 1 } (@{ PROBLEM_FIELDS() }, @{ SET_FIELDS() }); 476 my $check = $canOverride{$field}; 477 478 # $recordType is a shorthand in the return statement for problem or set 479 # $recordID is a shorthand in the return statement for $problemID or $setID 480 my $recordType = ""; 481 my $recordID = ""; 482 if (defined $problemID) { 483 $recordType = "problem"; 484 $recordID = $problemID; 485 } else { 486 $recordType = "set"; 487 $recordID = $setID; 488 } 489 490 # $inputType contains either an input box or a popup_menu for changing a given db field 491 my $inputType = ""; 492 if ($edit) { 493 $inputType = CGI::input({ 494 name => "$recordType.$recordID.$field", 495 value => $r->param("$recordType.$recordID.$field") || ($forUsers ? $userValue : $globalValue), 496 size => $properties{size} || 5, 497 }); 498 } elsif ($choose) { 499 # Note that in popup menus, you're almost guaranteed to have the choices hashed to labels in %properties 500 # but $userValue and and $globalValue are the values in the hash not the keys 501 # so we have to use the actual db record field values to select our default here. 502 503 # FIXME: this allows us to set one selector from two (or more) fields 504 # if $field matches /:/, we have to get two fields to get the data we need here 505 my $value = $r->param("$recordType.$recordID.$field"); 506 if ( ! $value && $field =~ /:/ ) { 507 my @fields = split(/:/, $field); 508 $value = ''; 509 foreach my $f ( @fields ) { 510 $value .= ($forUsers && $userRecord->$f ne '' ? $userRecord->$f : $globalRecord->$f) . ":"; 511 } 512 $value =~ s/:$//; 513 } elsif ( ! $value ) { 514 $value = ($forUsers && $userRecord->$field ne '' ? $userRecord->$field : $globalRecord->$field); 515 } 516 517 $inputType = CGI::popup_menu({ 518 name => "$recordType.$recordID.$field", 519 values => $properties{choices}, 520 labels => \%labels, 521 default => $value, 522 }); 523 } 524 525 my $gDisplVal = defined($properties{labels}) && defined($properties{labels}->{$globalValue}) ? $properties{labels}->{$globalValue} : $globalValue; 526 527 # FIXME: adding ":" in the checked => allows for multiple fields to be set by one selector 528 # return (($forUsers && $edit && $check) ? CGI::checkbox({ 529 return (($forUsers && $check) ? CGI::checkbox({ 530 type => "checkbox", 531 name => "$recordType.$recordID.$field.override", 532 label => "", 533 value => $field, 534 checked => $r->param("$recordType.$recordID.$field.override") || ($userValue ne ($labels{""} || $blankfield) ? 1 : 0), 535 }) : "", 536 $properties{name}, 537 $inputType, 538 $forUsers ? " $gDisplVal" : "", 539 ); 540 } 541 542 # return weird fields that are non-native or which are displayed 543 # for only some sets 544 sub extraSetFields { 545 my ($self,$userID,$setID,$globalRecord,$userRecord,$forUsers) = @_; 546 my $db = $self->r->{db}; 547 548 my ($gwFields, $ipFields, $ipDefaults, $numLocations, $ipOverride, 549 $procFields) = ( '', '', '', 0, '', '' ); 550 551 # if we're dealing with a gateway, set up a table of gateway fields 552 my $nF = 0; # this is the number of columns in the set field table 553 if ( $globalRecord->assignment_type() =~ /gateway/ ) { 554 my $gwhdr = "\n<!-- begin gwoutput table -->\n"; 555 556 foreach my $gwfield ( @{ GATEWAY_SET_FIELD_ORDER() } ) { 557 558 my @fieldData = 559 ($self->FieldHTML($userID, $setID, undef, 560 $globalRecord, $userRecord, 561 $gwfield)); 562 if ( @fieldData && defined($fieldData[1]) and 563 $fieldData[1] ne '' ) { 564 $nF = @fieldData if ( @fieldData > $nF ); 565 $gwFields .= CGI::Tr({}, 566 CGI::td({}, [@fieldData])); 567 } 568 } 569 $gwhdr .= CGI::Tr({},CGI::td({colspan=>$nF}, 570 CGI::em("Gateway parameters"))) 571 if ( $nF ); 572 $gwFields = "$gwhdr$gwFields\n" . 573 "<!-- end gwoutput table -->\n"; 574 } 575 576 # if we have a proctored test, then also generate a proctored 577 # set password input 578 if ( $globalRecord->assignment_type eq 'proctored_gateway' && ! $forUsers ) { 579 my $nfm1 = $nF - 1; 580 $procFields = CGI::Tr({},CGI::td({},''), 581 CGI::td({colspan=>$nfm1}, 582 CGI::em("Proctored tests require proctor " . 583 "authorization to start and to " . 584 "grade. Provide a password to have " . 585 "a single password for all students " . 586 "to start a proctored test."))); 587 # we use a routine other than FieldHTML because of getting 588 # the default value here 589 my @fieldData = 590 $self->proctoredFieldHTML($userID, $setID, 591 $globalRecord); 592 $procFields .= CGI::Tr({}, 593 CGI::td({}, [@fieldData])); 594 } 595 596 # finally, figure out what ip selector fields we want to include 597 my @locations = sort {$a cmp $b} ($db->listLocations()); 598 $numLocations = @locations; 599 600 if ( ( ! $forUsers && $globalRecord->restrict_ip && 601 $globalRecord->restrict_ip ne 'No' ) || 602 ( $forUsers && $userRecord->restrict_ip ne 'No' ) ) { 603 604 my @globalLocations = $db->listGlobalSetLocations($setID); 605 # what ip locations should be selected? 606 my @defaultLocations = (); 607 if ( $forUsers && 608 ! $db->countUserSetLocations($userID, $setID) ) { 609 @defaultLocations = @globalLocations; 610 $ipOverride = 0; 611 } elsif ( $forUsers ) { 612 @defaultLocations = $db->listUserSetLocations($userID, $setID); 613 $ipOverride = 1; 614 } else { 615 @defaultLocations = @globalLocations; 616 } 617 my $ipDefaults = join(', ', @globalLocations); 618 619 my $ipSelector = CGI::scrolling_list({ 620 -name => "set.$setID.selected_ip_locations", 621 -values => [ @locations ], 622 -default => [ @defaultLocations ], 623 -size => 5, 624 -multiple => 'true'}); 625 626 my $override = ($forUsers) ? 627 CGI::checkbox({ type => "checkbox", 628 name => "set.$setID.selected_ip_locations.override", 629 label => "", 630 checked => $ipOverride }) : ''; 631 $ipFields .= CGI::Tr({-valign=>'top'}, 632 CGI::td({}, [ $override, 633 'Restrict Locations', 634 $ipSelector, 635 $forUsers ? 636 " $ipDefaults" : '', ] 637 ), 638 ); 639 } 640 return($gwFields, $ipFields, $numLocations, $procFields); 641 } 642 643 sub proctoredFieldHTML { 644 my ( $self, $userID, $setID, $globalRecord ) = @_; 645 646 my $r = $self->r; 647 my $db = $r->db; 648 649 # note that this routine assumes that the login proctor password 650 # is something that can only be changed for the global set 651 652 # if the set doesn't require a login proctor, then we can assume 653 # that one doesn't exist; otherwise, we need to check the 654 # database to find if there's an already defined password 655 my $value = ''; 656 if ( $globalRecord->restricted_login_proctor eq 'Yes' && 657 $db->existsPassword("set_id:$setID") ) { 658 $value = '********'; 659 } 660 661 return( ( '', 662 'Password (Leave blank for regular proctoring)', 663 CGI::input({ name=>"set.$setID.restricted_login_proctor_password", 664 value=>$value, 665 size=>10, 666 }), 667 '' ) ); 668 } 669 670 # creates a popup menu of all possible problem numbers (for possible rearranging) 671 sub problem_number_popup { 672 my $num = shift; 673 my $total = shift; 674 return (CGI::popup_menu(-name => "problem_num_$num", 675 -values => [1..$total], 676 -default => $num)); 677 } 678 679 # handles rearrangement necessary after changes to problem ordering 680 sub handle_problem_numbers { 681 my $newProblemNumbersref = shift; 682 my %newProblemNumbers = %$newProblemNumbersref; 683 my $maxNum = shift; 684 my $db = shift; 685 my $setID = shift; 686 my $force = shift || 0; 687 my @sortme=(); 688 my ($j, $val); 689 690 # keys are current problem numbers, values are target problem numbers 691 foreach $j (keys %newProblemNumbers) { 692 # we don't want to act unless all problems have been assigned a new problem number, so if any have not, return 693 return "" if (not defined $newProblemNumbers{"$j"}); 694 # if the problem has been given a new number, we reduce the "score" of the problem by the original number of the problem 695 # when multiple problems are assigned the same number, this results in the last one ending up first -- FIXME? 696 if ($newProblemNumbers{"$j"} != $j) { 697 # force always gets set if reordering is done, so don't expect to be able to delete a problem, 698 # reorder some other problems, and end up with a hole -- FIXME 699 $force = 1; 700 $val = 1000 * $newProblemNumbers{$j} - $j; 701 } else { 702 $val = 1000 * $newProblemNumbers{$j}; 703 } 704 # store a mapping between current problem number and score (based on currnet and new problem number) 705 push @sortme, [$j, $val]; 706 # replace new problem numbers in hash with the (global) problems themselves 707 $newProblemNumbers{$j} = $db->getGlobalProblem($setID, $j); 708 die "global $j for set $setID not found." unless $newProblemNumbers{$j}; 709 } 710 711 # we don't have to do anything if we're not getting rid of holes 712 return "" unless $force; 713 714 # sort the curr. prob. num./score pairs by score 715 @sortme = sort {$a->[1] <=> $b->[1]} @sortme; 716 # now, for global and each user with this set, loop through problem list 717 # get all of the problem records 718 # assign new problem numbers 719 # loop - if number is new, put the problem record 720 # print "Sorted to get ". join(', ', map {$_->[0] } @sortme) ."<p>\n"; 721 722 723 # Now, three stages. First global values 724 725 for ($j = 0; $j < scalar @sortme; $j++) { 726 if($sortme[$j][0] == $j + 1) { 727 # if the jth problem (according to the new ordering) is in the right place (problem IDs are numbered from 1, hence $j+1) 728 # do nothing 729 } elsif (not defined $newProblemNumbers{$j + 1}) { 730 # otherwise, if there's a hole for it, add it there 731 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 732 $db->addGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 733 } else { 734 # otherwise, overwrite the data for the problem that's already there with the jth problem's data (with a changed problemID) 735 $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); 736 $db->putGlobalProblem($newProblemNumbers{$sortme[$j][0]}); 737 } 738 } 739 740 my @setUsers = $db->listSetUsers($setID); 741 my (@problist, $user); 742 743 foreach $user (@setUsers) { 744 # grab a copy of each UserProblem for this user. @problist can be sparse (if problems were deleted) 745 for $j (keys %newProblemNumbers) { 746 $problist[$j] = $db->getUserProblem($user, $setID, $j); 747 } 748 for($j = 0; $j < scalar @sortme; $j++) { 749 if ($sortme[$j][0] == $j + 1) { 750 # same as above -- the jth problem is in the right place, so don't worry about it 751 # do nothing 752 } elsif ($problist[$sortme[$j][0]]) { 753 # we've made sure the user's problem actually exists HERE, since we want to be able to fail gracefullly if it doesn't 754 # the problem with the original conditional below is that %newProblemNumbers maps oldids => global problem record 755 # we need to check if the target USER PROBLEM exists, which is what @problist knows 756 #if (not defined $newProblemNumbers{$j + 1}) { 757 if (not defined $problist[$j+1]) { 758 # same as above -- there's a hole for that problem to go into, so add it in its new place 759 $problist[$sortme[$j][0]]->problem_id($j + 1); 760 $db->addUserProblem($problist[$sortme[$j][0]]); 761 } else { 762 # same as above -- there's a problem already there, so overwrite its data with the data from the jth problem 763 $problist[$sortme[$j][0]]->problem_id($j + 1); 764 $db->putUserProblem($problist[$sortme[$j][0]]); 765 } 766 } else { 767 warn "UserProblem missing for user=$user set=$setID problem=$sortme[$j][0]. This may indicate database corruption.\n"; 768 # when a problem doesn't exist in the target slot, a new problem gets added there, but the original problem 769 # never gets overwritten (because there wan't a problem it would have to get exchanged with) 770 # 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: 771 # @sortme[$j][0] will contain: 4, 1, 2, 3 772 # - problem 1 will get **added** with the data from problem 4 (because problem 1 doesn't exist for this user) 773 # - problem 2 will get overwritten with the data from problem 1 774 # - problem 3 will get overwritten with the data from problem 2 775 # - nothing will happend to problem 4, since problem 1 doesn't exit 776 # so the solution is to delete problem 4 altogether! 777 # here's the fix: 778 779 # the data from problem $j+1 was/will be moved to another problem slot, 780 # but there's no problem $sortme[$j][0] to replace it. thus, we delete it now. 781 $db->deleteUserProblem($user, $setID, $j+1); 782 } 783 } 784 } 785 786 # any problems with IDs above $maxNum get deleted -- presumably their data has been copied into problems with lower IDs 787 foreach ($j = scalar @sortme; $j < $maxNum; $j++) { 788 if (defined $newProblemNumbers{$j + 1}) { 789 $db->deleteGlobalProblem($setID, $j+1); 790 } 791 } 792 793 # return a string form of the old problem IDs in the new order (not used by caller, incidentally) 794 return join(', ', map {$_->[0]} @sortme); 795 } 796 797 # swap index given with next bigger index 798 # leftover from when we had up/down buttons 799 # maybe we will bring them back 800 801 #sub moveme { 802 # my $index = shift; 803 # my $db = shift; 804 # my $setID = shift; 805 # my (@problemIDList) = @_; 806 # my ($prob1, $prob2, $prob); 807 # 808 # foreach my $problemID (@problemIDList) { 809 # my $problemRecord = $db->getGlobalProblem($setID, $problemID); # checked 810 # die "global $problemID for set $setID not found." unless $problemRecord; 811 # if ($problemRecord->problem_id == $index) { 812 # $prob1 = $problemRecord; 813 # } elsif ($problemRecord->problem_id == $index + 1) { 814 # $prob2 = $problemRecord; 815 # } 816 # } 817 # if (not defined $prob1 or not defined $prob2) { 818 # die "cannot find problem $index or " . ($index + 1); 819 # } 820 # 821 # $prob1->problem_id($index + 1); 822 # $prob2->problem_id($index); 823 # $db->putGlobalProblem($prob1); 824 # $db->putGlobalProblem($prob2); 825 # 826 # my @setUsers = $db->listSetUsers($setID); 827 # 828 # my $user; 829 # foreach $user (@setUsers) { 830 # $prob1 = $db->getUserProblem($user, $setID, $index); #checked 831 # die " problem $index for set $setID and effective user $user not found" 832 # unless $prob1; 833 # $prob2 = $db->getUserProblem($user, $setID, $index+1); #checked 834 # die " problem $index for set $setID and effective user $user not found" 835 # unless $prob2; 836 # $prob1->problem_id($index+1); 837 # $prob2->problem_id($index); 838 # $db->putUserProblem($prob1); 839 # $db->putUserProblem($prob2); 840 # } 841 #} 842 843 # primarily saves any changes into the correct set or problem records (global vs user) 844 # also deals with deleting or rearranging problems 845 sub initialize { 846 my ($self) = @_; 847 my $r = $self->r; 848 my $db = $r->db; 849 my $ce = $r->ce; 850 my $authz = $r->authz; 851 my $user = $r->param('user'); 852 my $setID = $r->urlpath->arg("setID"); 853 my $setRecord = $db->getGlobalSet($setID); # checked 854 die "global set $setID not found." unless $setRecord; 855 856 $self->{set} = $setRecord; 857 my @editForUser = $r->param('editForUser'); 858 # some useful booleans 859 my $forUsers = scalar(@editForUser); 860 my $forOneUser = $forUsers == 1; 861 862 # Check permissions 863 return unless ($authz->hasPermissions($user, "access_instructor_tools")); 864 return unless ($authz->hasPermissions($user, "modify_problem_sets")); 865 866 867 my %properties = %{ FIELD_PROPERTIES() }; 868 869 # takes a hash of hashes and inverts it 870 my %undoLabels; 871 foreach my $key (keys %properties) { 872 %{ $undoLabels{$key} } = map { $properties{$key}->{labels}->{$_} => $_ } keys %{ $properties{$key}->{labels} }; 873 } 874 875 # Unfortunately not everyone uses Javascript enabled browsers so 876 # we must fudge the information coming from the ComboBoxes 877 # Since the textfield and menu both have the same name, we get an array of two elements 878 # We then reset the param to the first if its not-empty or the second (empty or not). 879 foreach ( @{ HEADER_ORDER() } ) { 880 my @values = $r->param("set.$setID.$_"); 881 my $value = $values[0] || $values[1] || ""; 882 $r->param("set.$setID.$_", $value); 883 } 884 885 ##################################################################### 886 # Check date information 887 ##################################################################### 888 889 my ($open_date, $due_date, $answer_date); 890 my $error = 0; 891 if (defined $r->param('submit_changes')) { 892 my @names = ("open_date", "due_date", "answer_date"); 893 894 my %dates = map { $_ => $r->param("set.$setID.$_") } @names; 895 %dates = map { 896 my $unlabel = $undoLabels{$_}->{$dates{$_}}; 897 $_ => defined $unlabel ? $setRecord->$_ : $self->parseDateTime($dates{$_}) 898 } @names; 899 900 ($open_date, $due_date, $answer_date) = map { $dates{$_} } @names; 901 902 if ($answer_date < $due_date || $answer_date < $open_date) { 903 $self->addbadmessage("Answers cannot be made available until on or after the due date!"); 904 $error = $r->param('submit_changes'); 905 } 906 907 if ($due_date < $open_date) { 908 $self->addbadmessage("Answers cannot be due until on or after the open date!"); 909 $error = $r->param('submit_changes'); 910 } 911 912 # make sure the dates are not more than 10 years in the future 913 my $curr_time = time; 914 my $seconds_per_year = 31_556_926; 915 my $cutoff = $curr_time + $seconds_per_year*10; 916 if ($open_date > $cutoff) { 917 $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); 918 $error = $r->param('submit_changes'); 919 } 920 if ($due_date > $cutoff) { 921 $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); 922 $error = $r->param('submit_changes'); 923 } 924 if ($answer_date > $cutoff) { 925 $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); 926 $error = $r->param('submit_changes'); 927 } 928 929 } 930 if ($error) { 931 $self->addbadmessage("No changes were saved!"); 932 } 933 934 if (defined $r->param('submit_changes') && !$error) { 935 936 #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam 937 938 ##################################################################### 939 # Save general set information (including headers) 940 ##################################################################### 941 942 if ($forUsers) { 943 # note that we don't deal with the proctor user 944 # fields here, with the assumption that it can't 945 # be possible to change them for users. this is 946 # not the most robust treatment of the problem 947 # (FIXME) 948 949 # DBFIXME use a WHERE clause, iterator 950 my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser); 951 foreach my $record (@userRecords) { 952 foreach my $field ( @{ SET_FIELDS() } ) { 953 next unless canChange($forUsers, $field); 954 my $override = $r->param("set.$setID.$field.override"); 955 956 if (defined $override && $override eq $field) { 957 958 my $param = $r->param("set.$setID.$field"); 959 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 960 my $unlabel = $undoLabels{$field}->{$param}; 961 $param = $unlabel if defined $unlabel; 962 # $param = $undoLabels{$field}->{$param} || $param; 963 if ($field =~ /_date/) { 964 $param = $self->parseDateTime($param) unless defined $unlabel; 965 } 966 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { 967 $param = $param*$properties{$field}->{convertby}; 968 } 969 # special case; does field fill in multiple values? 970 if ( $field =~ /:/ ) { 971 my @values = split(/:/, $param); 972 my @fields = split(/:/, $field); 973 for ( my $i=0; $i<@values; $i++ ) { 974 my $f=$fields[$i]; 975 $record->$f($values[$i]); 976 } 977 } else { 978 $record->$field($param); 979 } 980 } else { 981 #################### 982 # FIXME: allow one selector to set multiple fields 983 # 984 if ( $field =~ /:/ ) { 985 foreach my $f ( split(/:/, $field) ) { 986 $record->$f(undef); 987 } 988 } else { 989 $record->$field(undef); 990 } 991 } 992 993 } 994 #################### 995 # FIXME: this is replaced by our allowing multiple fields to be set by one selector 996 # a check for hiding scores: if we have 997 # $set->hide_score eq 'N', we also want 998 # $set->hide_score_by_problem eq 'N' 999 # if ( $record->hide_score eq 'N' ) { 1000 # $record->hide_score_by_problem('N'); 1001 # } 1002 #################### 1003 $db->putUserSet($record); 1004 } 1005 1006 ####################################################### 1007 # Save IP restriction Location information 1008 ####################################################### 1009 # FIXME: it would be nice to have this in the field values 1010 # hash, so that we don't have to assume that we can 1011 # override this information for users 1012 1013 if ( $r->param("set.$setID.selected_ip_locations.override") ) { 1014 foreach my $record ( @userRecords ) { 1015 my $userID = $record->user_id; 1016 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1017 my @userSetLocations = $db->listUserSetLocations($userID,$setID); 1018 my @addSetLocations = (); 1019 my @delSetLocations = (); 1020 foreach my $loc ( @selectedLocations ) { 1021 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) ); 1022 } 1023 foreach my $loc ( @userSetLocations ) { 1024 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1025 } 1026 # then update the user set_locations 1027 foreach ( @addSetLocations ) { 1028 my $Loc = $db->newUserSetLocation; 1029 $Loc->set_id( $setID ); 1030 $Loc->user_id( $userID ); 1031 $Loc->location_id($_); 1032 $db->addUserSetLocation($Loc); 1033 } 1034 foreach ( @delSetLocations ) { 1035 $db->deleteUserSetLocation($userID,$setID,$_); 1036 } 1037 } 1038 } else { 1039 # if override isn't selected, then we want 1040 # to be sure that there are no 1041 # set_locations_user entries setting around 1042 foreach my $record ( @userRecords ) { 1043 my $userID = $record->user_id; 1044 my @userLocations = $db->listUserSetLocations($userID,$setID); 1045 foreach ( @userLocations ) { 1046 $db->deleteUserSetLocation($userID,$setID,$_); 1047 } 1048 } 1049 } 1050 } else { 1051 foreach my $field ( @{ SET_FIELDS() } ) { 1052 next unless canChange($forUsers, $field); 1053 1054 my $param = $r->param("set.$setID.$field"); 1055 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1056 1057 my $unlabel = $undoLabels{$field}->{$param}; 1058 $param = $unlabel if defined $unlabel; 1059 if ($field =~ /_date/) { 1060 $param = $self->parseDateTime($param) unless defined $unlabel; 1061 } 1062 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby} && $param) { 1063 $param = $param*$properties{$field}->{convertby}; 1064 } 1065 # special case; does field fill in multiple values? 1066 if ( $field =~ /:/ ) { 1067 my @values = split(/:/, $param); 1068 my @fields = split(/:/, $field); 1069 for ( my $i=0; $i<@fields; $i++ ) { 1070 my $f = $fields[$i]; 1071 $setRecord->$f($values[$i]); 1072 } 1073 } else { 1074 $setRecord->$field($param); 1075 } 1076 } 1077 #################### 1078 # FIXME: this is replaced by our setting both hide_score and hide_score_by_problem 1079 # with a single drop down 1080 # 1081 # # a check for hiding scores: if we have 1082 # # $set->hide_score eq 'N', we also want 1083 # # $set->hide_score_by_problem eq 'N', and if it's 1084 # # changed to 'Y' and hide_score_by_problem is Null, 1085 # # give it a value 'N' 1086 # if ( $setRecord->hide_score eq 'N' || 1087 # ( ! defined($setRecord->hide_score_by_problem) || 1088 # $setRecord->hide_score_by_problem eq '' ) ) { 1089 # $setRecord->hide_score_by_problem('N'); 1090 # } 1091 #################### 1092 $db->putGlobalSet($setRecord); 1093 1094 ####################################################### 1095 # Save IP restriction Location information 1096 ####################################################### 1097 1098 if ( defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No' ) { 1099 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1100 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1101 my @addSetLocations = (); 1102 my @delSetLocations = (); 1103 foreach my $loc ( @selectedLocations ) { 1104 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @globalSetLocations ) ); 1105 } 1106 foreach my $loc ( @globalSetLocations ) { 1107 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1108 } 1109 # then update the global set_locations 1110 foreach ( @addSetLocations ) { 1111 my $Loc = $db->newGlobalSetLocation; 1112 $Loc->set_id( $setID ); 1113 $Loc->location_id($_); 1114 $db->addGlobalSetLocation($Loc); 1115 } 1116 foreach ( @delSetLocations ) { 1117 $db->deleteGlobalSetLocation($setID,$_); 1118 } 1119 } else { 1120 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1121 foreach ( @globalSetLocations ) { 1122 $db->deleteGlobalSetLocation($setID,$_); 1123 } 1124 } 1125 1126 ####################################################### 1127 # Save proctored problem proctor user information 1128 ####################################################### 1129 if ($r->param("set.$setID.restricted_login_proctor_password") && 1130 $setRecord->assignment_type eq 'proctored_gateway') { 1131 # in this case we're adding a set-level proctor 1132 # or updating the password 1133 1134 my $procID = "set_id:$setID"; 1135 my $pass = $r->param("set.$setID.restricted_login_proctor_password"); 1136 # should we carefully check in this case that 1137 # the user and password exist? the code 1138 # in the add stanza is pretty careful to 1139 # be sure that there's a one-to-one 1140 # correspondence between the existence of 1141 # the user and the setting of the set 1142 # restricted_login_proctor field, so we 1143 # assume that just checking the latter 1144 # here is sufficient. 1145 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1146 # in this case we already have a set 1147 # level proctor, and so should be 1148 # resetting the password 1149 if ( $pass ne '********' ) { 1150 # then we submitted a new 1151 # password, so save it 1152 my $dbPass; 1153 eval { $dbPass = $db->getPassword($procID) }; 1154 if ( $@ ) { 1155 $self->addbadmessage("Error getting old set-proctor password from the database: $@. No update to the password was done."); 1156 } else { 1157 $dbPass->password(cryptPassword($pass)); 1158 $db->putPassword($dbPass); 1159 } 1160 } 1161 1162 } else { 1163 $setRecord->restricted_login_proctor('Yes'); 1164 my $procUser = $db->newUser(); 1165 $procUser->user_id($procID); 1166 $procUser->last_name("Proctor"); 1167 $procUser->first_name("Login"); 1168 $procUser->student_id("loginproctor"); 1169 $procUser->status($ce->status_name_to_abbrevs('Proctor')); 1170 my $procPerm = $db->newPermissionLevel; 1171 $procPerm->user_id($procID); 1172 $procPerm->permission($ce->{userRoles}->{login_proctor}); 1173 my $procPass = $db->newPassword; 1174 $procPass->user_id($procID); 1175 $procPass->password(cryptPassword($pass)); 1176 # put these into the database 1177 eval { $db->addUser($procUser) }; 1178 if ( $@ ) { 1179 $self->addbadmessage("Error " . 1180 "adding set-level " . 1181 "proctor: $@"); 1182 } else { 1183 $db->addPermissionLevel($procPerm); 1184 $db->addPassword($procPass); 1185 } 1186 1187 # and set the restricted_login_proctor 1188 # set field 1189 $db->putGlobalSet( $setRecord ); 1190 } 1191 1192 } else { 1193 # if the parameter isn't set, or if the assignment 1194 # type is not 'proctored_gateway', then we need to be 1195 # sure that there's no set-level proctor defined 1196 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1197 1198 $setRecord->restricted_login_proctor('No'); 1199 $db->deleteUser( "set_id:$setID" ); 1200 $db->putGlobalSet( $setRecord ); 1201 1202 } 1203 } 1204 } 1205 1206 ##################################################################### 1207 # Save problem information 1208 ##################################################################### 1209 1210 # DBFIXME use a WHERE clause, iterator? 1211 my @problemIDs = sort { $a <=> $b } $db->listGlobalProblems($setID);; 1212 my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); 1213 foreach my $problemRecord (@problemRecords) { 1214 my $problemID = $problemRecord->problem_id; 1215 die "Global problem $problemID for set $setID not found." unless $problemRecord; 1216 1217 if ($forUsers) { 1218 # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page 1219 # So we only need to make changes to the UserProblem record and only then if we are overriding a value 1220 # in the GlobalProblem record or for fields unique to the UserProblem record. 1221 1222 my @userIDs = @editForUser; 1223 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1224 # DBFIXME where clause? iterator? 1225 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1226 foreach my $record (@userProblemRecords) { 1227 1228 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1229 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1230 next unless canChange($forUsers, $field); 1231 1232 my $override = $r->param("problem.$problemID.$field.override"); 1233 if (defined $override && $override eq $field) { 1234 1235 my $param = $r->param("problem.$problemID.$field"); 1236 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1237 my $unlabel = $undoLabels{$field}->{$param}; 1238 $param = $unlabel if defined $unlabel; 1239 $changed ||= changed($record->$field, $param); 1240 $record->$field($param); 1241 } else { 1242 $changed ||= changed($record->$field, undef); 1243 $record->$field(undef); 1244 } 1245 1246 } 1247 1248 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1249 next unless canChange($forUsers, $field); 1250 1251 my $param = $r->param("problem.$problemID.$field"); 1252 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1253 my $unlabel = $undoLabels{$field}->{$param}; 1254 $param = $unlabel if defined $unlabel; 1255 $changed ||= changed($record->$field, $param); 1256 $record->$field($param); 1257 } 1258 $db->putUserProblem($record) if $changed; 1259 } 1260 } else { 1261 # Since we're editing for ALL set users, we will make changes to the GlobalProblem record. 1262 # We may also have instances where a field is unique to the UserProblem record but we want 1263 # all users to (at least initially) have the same value 1264 1265 # this only edits a globalProblem record 1266 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1267 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1268 next unless canChange($forUsers, $field); 1269 1270 my $param = $r->param("problem.$problemID.$field"); 1271 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1272 my $unlabel = $undoLabels{$field}->{$param}; 1273 $param = $unlabel if defined $unlabel; 1274 $changed ||= changed($problemRecord->$field, $param); 1275 $problemRecord->$field($param); 1276 } 1277 $db->putGlobalProblem($problemRecord) if $changed; 1278 1279 1280 # sometimes (like for status) we might want to change an attribute in 1281 # the userProblem record for every assigned user 1282 # However, since this data is stored in the UserProblem records, 1283 # it won't be displayed once its been changed and if you hit "Save Changes" again 1284 # it gets erased 1285 1286 # So we'll enforce that there be something worth putting in all the UserProblem records 1287 # This also will make hitting "Save Changes" on the global page MUCH faster 1288 my %useful; 1289 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1290 my $param = $r->param("problem.$problemID.$field"); 1291 $useful{$field} = 1 if defined $param and $param ne ""; 1292 } 1293 1294 if (keys %useful) { 1295 # DBFIXME where clause, iterator 1296 my @userIDs = $db->listProblemUsers($setID, $problemID); 1297 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1298 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1299 foreach my $record (@userProblemRecords) { 1300 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1301 foreach my $field ( keys %useful ) { 1302 next unless canChange($forUsers, $field); 1303 1304 my $param = $r->param("problem.$problemID.$field"); 1305 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1306 my $unlabel = $undoLabels{$field}->{$param}; 1307 $param = $unlabel if defined $unlabel; 1308 $changed ||= changed($record->$field, $param); 1309 $record->$field($param); 1310 } 1311 $db->putUserProblem($record) if $changed; 1312 } 1313 } 1314 } 1315 } 1316 1317 # Mark the specified problems as correct for all users 1318 foreach my $problemID ($r->param('markCorrect')) { 1319 # DBFIXME where clause, iterator 1320 my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID)); 1321 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1322 foreach my $record (@userProblemRecords) { 1323 if (defined $record && ($record->status eq "" || $record->status < 1)) { 1324 $record->status(1); 1325 $record->attempted(1); 1326 $db->putUserProblem($record); 1327 } 1328 } 1329 } 1330 1331 # Delete all problems marked for deletion 1332 foreach my $problemID ($r->param('deleteProblem')) { 1333 $db->deleteGlobalProblem($setID, $problemID); 1334 } 1335 1336 ##################################################################### 1337 # Add blank problem if needed 1338 ##################################################################### 1339 if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { 1340 # get number of problems to add and clean the entry 1341 my $newBlankProblems = (defined($r->param("add_n_problems")) ) ? $r->param("add_n_problems") :1; 1342 $newBlankProblems = int($newBlankProblems); 1343 my $MAX_NEW_PROBLEMS = 20; 1344 if ($newBlankProblems >=1 and $newBlankProblems <= $MAX_NEW_PROBLEMS ) { 1345 foreach my $newProb (1..$newBlankProblems) { 1346 my $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setID)); 1347 ################################################## 1348 # make local copy of the blankProblem 1349 ################################################## 1350 my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; 1351 my $problemContents = WeBWorK::Utils::readFile($blank_file_path); 1352 my $new_file_path = "set$setID/".BLANKPROBLEM(); 1353 my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); 1354 local(*TEMPFILE); 1355 open(TEMPFILE, ">$fullPath") or warn "Can't write to file $fullPath"; 1356 print TEMPFILE $problemContents; 1357 close(TEMPFILE); 1358 1359 ################################################# 1360 # Update problem record 1361 ################################################# 1362 my $problemRecord = $self->addProblemToSet( 1363 setName => $setID, 1364 sourceFile => $new_file_path, 1365 problemID => $targetProblemNumber, #added to end of set 1366 ); 1367 $self->assignProblemToAllSetUsers($problemRecord); 1368 $self->addgoodmessage("Added $new_file_path to ". $setID. " as problem $targetProblemNumber") ; 1369 } 1370 } else { 1371 $self->addbadmessage("Could not add $newBlankProblems problems to this set. The number must be between 1 and $MAX_NEW_PROBLEMS"); 1372 } 1373 } 1374 1375 # Sets the specified header to "" so that the default file will get used. 1376 foreach my $header ($r->param('defaultHeader')) { 1377 $setRecord->$header(""); 1378 } 1379 } 1380 1381 # Leftover code from when there were up/down buttons 1382 1383 # } else { 1384 # # Look for up and down buttons 1385 # my $index = 2; 1386 # while ($index <= scalar @problemList) { 1387 # if (defined $r->param("move.up.$index.x")) { 1388 # moveme($index-1, $db, $setID, @problemList); 1389 # } 1390 # $index++; 1391 # } 1392 # $index = 1; 1393 # 1394 # while ($index < scalar @problemList) { 1395 # if (defined $r->param("move.down.$index.x")) { 1396 # moveme($index, $db, $setID, @problemList); 1397 # } 1398 # $index++; 1399 # } 1400 # } 1401 1402 1403 # This erases any sticky fields if the user saves changes, resets the form, or reorders problems 1404 # It may not be obvious why this is necessary when saving changes or reordering problems 1405 # but when the problems are reorder the param problem.1.source_file needs to be the source 1406 # file of the problem that is NOW #1 and not the problem that WAS #1. 1407 unless (defined $r->param('refresh')) { 1408 1409 # reset all the parameters dealing with set/problem/header information 1410 # if the current naming scheme is changed/broken, this could reek havoc 1411 # on all kinds of things 1412 foreach my $param ($r->param) { 1413 $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; 1414 } 1415 } 1416 } 1417 1418 # helper method for debugging 1419 sub definedness ($) { 1420 my ($variable) = @_; 1421 1422 return "undefined" unless defined $variable; 1423 return "empty" unless $variable ne ""; 1424 return $variable; 1425 } 1426 1427 # helper method for checking if two things are different 1428 # the return values will usually be thrown away, but they could be useful for debugging 1429 sub changed ($$) { 1430 my ($first, $second) = @_; 1431 1432 return "def/undef" if defined $first and not defined $second; 1433 return "undef/def" if not defined $first and defined $second; 1434 return "" if not defined $first and not defined $second; 1435 return "ne" if $first ne $second; 1436 return ""; # if they're equal, there's no change 1437 } 1438 1439 # helper method that determines for how many users at a time a field can be changed 1440 # none means it can't be changed for anyone 1441 # any means it can be changed for anyone 1442 # one means it can ONLY be changed for one at a time. (eg problem_seed) 1443 # all means it can ONLY be changed for all at a time. (eg set_header) 1444 sub canChange ($$) { 1445 my ($forUsers, $field) = @_; 1446 1447 my %properties = %{ FIELD_PROPERTIES() }; 1448 my $forOneUser = $forUsers == 1; 1449 1450 my $howManyCan = $properties{$field}->{override}; 1451 1452 return 0 if $howManyCan eq "none"; 1453 return 1 if $howManyCan eq "any"; 1454 return 1 if $howManyCan eq "one" && $forOneUser; 1455 return 1 if $howManyCan eq "all" && !$forUsers; 1456 return 0; # FIXME: maybe it should default to 1? 1457 } 1458 1459 # helper method that determines if a file is valid and returns a pretty error message 1460 sub checkFile ($) { 1461 my ($self, $file) = @_; 1462 1463 my $r = $self->r; 1464 my $ce = $r->ce; 1465 1466 return "No source file specified" unless $file; 1467 $file = $ce->{courseDirs}->{templates} . '/' . $file unless $file =~ m|^/|; 1468 1469 my $text = "This source file "; 1470 my $fileError; 1471 return "" if -e $file && -f $file && -r $file; 1472 return $text . "is not readable!" if -e $file && -f $file; 1473 return $text . "is a directory!" if -d $file; 1474 return $text . "does not exist!" unless -e $file; 1475 return $text . "is not a plain file!"; 1476 } 1477 1478 # don't show view options -- we provide display mode controls for headers/problems separately 1479 sub options { 1480 return ""; 1481 } 1482 1483 # Creates two separate tables, first of the headers, and the of the problems in a given set 1484 # If one or more users are specified in the "editForUser" param, only the data for those users 1485 # becomes editable, not all the data 1486 sub body { 1487 1488 my ($self) = @_; 1489 my $r = $self->r; 1490 my $db = $r->db; 1491 my $ce = $r->ce; 1492 my $authz = $r->authz; 1493 my $userID = $r->param('user'); 1494 my $urlpath = $r->urlpath; 1495 my $courseID = $urlpath->arg("courseID"); 1496 my $setID = $urlpath->arg("setID"); 1497 my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; 1498 1499 my $userRecord = $db->getUser($userID) or die "No record for user $userID."; 1500 # Check permissions 1501 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 1502 unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); 1503 1504 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") 1505 unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); 1506 1507 my @editForUser = $r->param('editForUser'); 1508 1509 # Check that every user that we're editing for has a valid UserSet 1510 my @assignedUsers; 1511 my @unassignedUsers; 1512 if (scalar @editForUser) { 1513 foreach my $ID (@editForUser) { 1514 # DBFIXME iterator 1515 if ($db->getUserSet($ID, $setID)) { 1516 unshift @assignedUsers, $ID; 1517 } else { 1518 unshift @unassignedUsers, $ID; 1519 } 1520 } 1521 @editForUser = sort @assignedUsers; 1522 $r->param("editForUser", \@editForUser); 1523 1524 if (scalar @editForUser && scalar @unassignedUsers) { 1525 print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); 1526 } elsif (scalar @editForUser == 0) { 1527 print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); 1528 print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); 1529 } 1530 } 1531 1532 # some useful booleans 1533 my $forUsers = scalar(@editForUser); 1534 my $forOneUser = $forUsers == 1; 1535 1536 # If you're editing for users, initially their records will be different but 1537 # if you make any changes to them they will be the same. 1538 # if you're editing for one user, the problems shown should be his/hers 1539 my $userToShow = $forUsers ? $editForUser[0] : $userID; 1540 1541 # DBFIXME no need to get ID lists -- counts would be fine 1542 my $userCount = $db->listUsers(); 1543 my $setCount = $db->listGlobalSets(); # if $forOneUser; 1544 my $setUserCount = $db->countSetUsers($setID); 1545 my $userSetCount = $db->countUserSets($editForUser[0]) if $forOneUser; 1546 1547 1548 my $editUsersAssignedToSetURL = $self->systemLink( 1549 $urlpath->newFromModule( 1550 "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", 1551 courseID => $courseID, setID => $setID)); 1552 my $editSetsAssignedToUserURL = $self->systemLink( 1553 $urlpath->newFromModule( 1554 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1555 courseID => $courseID, userID => $editForUser[0])) if $forOneUser; 1556 1557 1558 my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); 1559 my $setDetailURL = $self->systemLink($setDetailPage, authen=>0); 1560 1561 1562 my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); 1563 my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; 1564 1565 $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; 1566 $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; 1567 1568 if ($forUsers) { 1569 ############################################## 1570 # calculate links for the users being edited: 1571 ############################################## 1572 my @userLinks = (); 1573 foreach my $userID (@editForUser) { 1574 my $u = $db->getUser($userID); 1575 my $email_address = $u->email_address; 1576 my $line = $u->last_name.", ".$u->first_name." (".CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id."). Assigned to "; 1577 my $editSetsAssignedToUserURL = $self->systemLink( 1578 $urlpath->newFromModule( 1579 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1580 courseID => $courseID, userID => $u->user_id)); 1581 $line .= CGI::a({href=>$editSetsAssignedToUserURL}, 1582 $self->setCountMessage($db->countUserSets($u->user_id), $setCount)); 1583 unshift @userLinks,$line; 1584 } 1585 @userLinks = sort @userLinks; 1586 1587 print CGI::table({border=>2,cellpadding=>10}, 1588 CGI::Tr({}, 1589 CGI::td([ 1590 "Editing problem set ".CGI::strong($setID)." data for these individual students:".CGI::br(). 1591 CGI::strong(join CGI::br(), @userLinks), 1592 CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set."), 1593 1594 ]) 1595 ) 1596 ); 1597 } else { 1598 print CGI::table({border=>2,cellpadding=>10}, 1599 CGI::Tr({}, 1600 CGI::td([ 1601 "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 1602 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", 1603 1604 ]) 1605 ) 1606 ); 1607 } 1608 1609 # handle renumbering of problems if necessary 1610 print CGI::a({name=>"problems"}); 1611 1612 my %newProblemNumbers = (); 1613 my $maxProblemNumber = -1; 1614 for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { 1615 $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); 1616 $maxProblemNumber = $jj if $jj > $maxProblemNumber; 1617 } 1618 1619 my $forceRenumber = $r->param('force_renumber') || 0; 1620 handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); 1621 1622 my %properties = %{ FIELD_PROPERTIES() }; 1623 1624 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1625 my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; 1626 push @active_modes, 'None'; 1627 my $default_header_mode = $r->param('header.displaymode') || 'None'; 1628 my $default_problem_mode = $r->param('problem.displaymode') || 'None'; 1629 1630 ##################################################################### 1631 # Browse available header/problem files 1632 ##################################################################### 1633 1634 my $templates = $r->ce->{courseDirs}->{templates}; 1635 my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); 1636 1637 my @headerFileList = listFilesRecursive( 1638 $templates, 1639 qr/header.*\.pg$/i, # match these files 1640 qr/^(?:$skip|CVS)$/, # prune these directories 1641 0, # match against file name only 1642 1, # prune against path relative to $templates 1643 ); 1644 1645 # this just takes too much time to search 1646 # my @problemFileList = listFilesRecursive( 1647 # $templates, 1648 # qr/\.pg$/i, # problem files don't say problem 1649 # qr/^(?:$skip|CVS)$/, # prune these directories 1650 # 0, # match against file name only 1651 # 1, # prune against path relative to $templates 1652 # ); 1653 1654 # Display a useful warning message 1655 if ($forUsers) { 1656 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . 1657 ($forOneUser ? "" : "s") . " listed above.")); 1658 } else { 1659 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); 1660 } 1661 1662 print CGI::start_form({method=>"POST", action=>$setDetailURL}); 1663 print $self->hiddenEditForUserFields(@editForUser); 1664 print $self->hidden_authen_fields; 1665 print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); 1666 print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); 1667 1668 # spacing 1669 print CGI::p(); 1670 1671 ##################################################################### 1672 # Display general set information 1673 ##################################################################### 1674 1675 print CGI::start_table({border=>1, cellpadding=>4}); 1676 print CGI::Tr({}, CGI::th({}, [ 1677 "General Information", 1678 ])); 1679 1680 # this is kind of a hack -- we need to get a user record here, so we can 1681 # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so 1682 # FieldHTML doesn't have to fetch it itself. 1683 my $userSetRecord = $db->getUserSet($userToShow, $setID); 1684 1685 print CGI::Tr({}, CGI::td({}, [ 1686 $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), 1687 ])); 1688 print CGI::end_table(); 1689 1690 # spacing 1691 print CGI::p(); 1692 1693 1694 ##################################################################### 1695 # Display header information 1696 ##################################################################### 1697 my @headers = @{ HEADER_ORDER() }; 1698 my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); 1699 my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); 1700 my @headerFiles = map { $setRecord->{$_} } @headers; 1701 if (scalar @headers and not $forUsers) { 1702 1703 print CGI::start_table({border=>1, cellpadding=>4}); 1704 print CGI::Tr({}, CGI::th({}, [ 1705 "Headers", 1706 # "Data", 1707 "Display Mode: " . 1708 CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. 1709 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1710 ])); 1711 1712 my %header_html; 1713 1714 my %error; 1715 my $this_set = $db->getMergedSet($userToShow, $setID); 1716 1717 foreach my $header (@headers) { 1718 1719 my $headerFile = $r->param("set.$setID.$header") || $setRecord->{$header} || $headerDefaults{$header}; 1720 1721 $error{$header} = $self->checkFile($headerFile); 1722 1723 unless ($error{$header}) { 1724 my @temp = renderProblems( 1725 r=> $r, 1726 user => $db->getUser($userToShow), 1727 displayMode=> $default_header_mode, 1728 problem_number=> 0, 1729 this_set => $this_set, 1730 problem_list => [$headerFile], 1731 ); 1732 $header_html{$header} = $temp[0]; 1733 } 1734 } 1735 1736 foreach my $header (@headers) { 1737 1738 my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); 1739 my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $header, make_local_copy => 1 }); 1740 1741 my $viewHeaderPage = $urlpath->new(type => $headerModules{$header}, args => { courseID => $courseID, setID => $setID }); 1742 my $viewHeaderLink = $self->systemLink($viewHeaderPage); 1743 1744 # this is a bit of a hack; the set header isn't shown 1745 # for gateway tests, and we run into trouble trying to 1746 # edit/view it in this context, so we don't show this 1747 # field for gateway tests 1748 if ( $header eq 'set_header' && 1749 $this_set->assignment_type =~ /gateway/ ) { 1750 print CGI::Tr({}, CGI::td({}, 1751 [ "Set Header", 1752 "Set headers are not used in " . 1753 "display of gateway tests."])); 1754 next; 1755 } 1756 1757 1758 print CGI::Tr({}, CGI::td({}, [ 1759 CGI::start_table({border => 0, cellpadding => 0}) . 1760 CGI::Tr({}, CGI::td({}, $properties{$header}->{name})) . 1761 CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . 1762 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . 1763 # CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "defaultHeader", value => $header, label => "Use Default"}))) . 1764 CGI::end_table(), 1765 # "", 1766 # CGI::input({ name => "set.$setID.$header", value => $setRecord->{$header}, size => 50}) . 1767 # join ("\n", $self->FieldHTML($userToShow, $setID, $problemID, "source_file")) . 1768 # CGI::br() . CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}), 1769 1770 comboBox({ 1771 name => "set.$setID.$header", 1772 request => $r, 1773 default => $r->param("set.$setID.$header") || $setRecord->{$header}, 1774 multiple => 0, 1775 values => ["", @headerFileList], 1776 labels => { "" => "Use Default Header File" }, 1777 }) . 1778 ($error{$header} ? 1779 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$header}) 1780 : CGI::div({class=> "RenderSolo"}, $header_html{$header}->{body_text}) 1781 ), 1782 ])); 1783 } 1784 1785 print CGI::end_table(); 1786 } else { 1787 print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); 1788 } 1789 1790 # spacing 1791 print CGI::p(); 1792 1793 1794 ##################################################################### 1795 # Display problem information 1796 ##################################################################### 1797 1798 my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); 1799 1800 # DBFIXME use iterators instead of getting all at once 1801 1802 # get global problem records for all problems in one go 1803 my %GlobalProblems; 1804 my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; 1805 # DBFIXME shouldn't need to get key list here 1806 @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); 1807 1808 # if needed, get user problem records for all problems in one go 1809 my (%UserProblems, %MergedProblems); 1810 if ($forOneUser) { 1811 my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; 1812 # DBFIXME shouldn't need to get key list here 1813 @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); 1814 @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); 1815 } 1816 1817 if (scalar @problemIDList) { 1818 1819 print CGI::start_table({border=>1, cellpadding=>4}); 1820 print CGI::Tr({}, CGI::th({}, [ 1821 "Problems", 1822 "Data", 1823 "Display Mode: " . 1824 CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. 1825 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1826 ])); 1827 1828 my %shownYet; 1829 my $repeatFile; 1830 foreach my $problemID (@problemIDList) { 1831 1832 my $problemRecord; 1833 if ($forOneUser) { 1834 #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); 1835 $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam 1836 } else { 1837 #$problemRecord = $db->getGlobalProblem($setID, $problemID); 1838 $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam 1839 } 1840 1841 #$self->addgoodmessage(""); 1842 #$self->addbadmessage($problemRecord->toString()); 1843 1844 1845 my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1846 my $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 1847 1848 1849 # FIXME: should we have an "act as" type link here when editing for multiple users? 1850 my $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 1851 my $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); 1852 1853 my @fields = @{ PROBLEM_FIELDS() }; 1854 push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser; 1855 1856 my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; 1857 1858 # warn of repeat problems 1859 if (defined $shownYet{$problemFile}) { 1860 $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; 1861 } else { 1862 $shownYet{$problemFile} = $problemID; 1863 $repeatFile = ""; 1864 } 1865 1866 my $error = $self->checkFile($problemFile); 1867 my $this_set = $db->getMergedSet($userToShow, $setID); 1868 my @problem_html; 1869 unless ($error) { 1870 @problem_html = renderProblems( 1871 r=> $r, 1872 user => $db->getUser($userToShow), 1873 displayMode=> $default_problem_mode, 1874 problem_number=> $problemID, 1875 this_set => $this_set, 1876 problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, 1877 problem_list => [$problemRecord->source_file], 1878 ); 1879 } 1880 1881 print CGI::Tr({}, CGI::td({}, [ 1882 CGI::start_table({border => 0, cellpadding => 1}) . 1883 CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . 1884 CGI::Tr({}, CGI::td({}, CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it"))) . 1885 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")))) . 1886 ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . 1887 # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . 1888 ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . 1889 CGI::end_table(), 1890 $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}), 1891 # A comprehensive list of problems is just TOO big to be handled well 1892 # comboBox({ 1893 # name => "set.$setID.$problemID", 1894 # request => $r, 1895 # default => $problemRecord->{problem_id}, 1896 # multiple => 0, 1897 # values => \@problemFileList, 1898 # }) . 1899 1900 join ("\n", $self->FieldHTML( 1901 $userToShow, 1902 $setID, 1903 $problemID, 1904 $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam 1905 $UserProblems{$problemID}, # pass previously fetched user record to FieldHTML --sam 1906 "source_file" 1907 )) . 1908 CGI::br() . 1909 ($error ? 1910 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) 1911 : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) 1912 ) . 1913 ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), 1914 ])); 1915 } 1916 1917 1918 # print final lines 1919 print CGI::end_table(); 1920 print CGI::checkbox({ 1921 label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", 1922 name=>"force_renumber", value=>"1"}); 1923 print CGI::p(<<EOF); 1924 Any time problem numbers are intentionally changed, the problems will 1925 always be renumbered consecutively, starting from one. When deleting 1926 problems, gaps will be left in the numbering unless the box above is 1927 checked. 1928 EOF 1929 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()); 1930 print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); 1931 1932 } else { 1933 print CGI::p(CGI::b("This set doesn't contain any problems yet.")); 1934 } 1935 # always allow one to add a new problem. 1936 print CGI::checkbox({ 1937 label=> "Add", 1938 name=>"add_blank_problem", value=>"1"} 1939 ),CGI::input({ 1940 name=>"add_n_problems", 1941 size=>2, 1942 value=>1 1943 }, 1944 "blank problem template(s) to end of homework set" 1945 ), 1946 CGI::br(),CGI::br(), 1947 CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), 1948 CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), 1949 "(Any unsaved changes will be lost.)" 1950 ; 1951 1952 1953 1954 #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); 1955 #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); 1956 # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME 1957 #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); 1958 1959 print CGI::end_form(); 1960 1961 return ""; 1962 } 1963 1964 1; 1965 1966 =head1 AUTHOR 1967 1968 Written by Robert Van Dam, toenail (at) cif.rochester.edu 1969 1970 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |