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