Parent Directory
| 
Revision Log
Fix to prevent the error messages that occur when the problem set has not yet been assigned to a user. Still a bit fragile and under tested but it at least stops the error messages from being issued.
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 Scoring 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 1561 return 0 if $howManyCan eq "none"; 1562 return 1 if $howManyCan eq "any"; 1563 return 1 if $howManyCan eq "one" && $forOneUser; 1564 return 1 if $howManyCan eq "all" && !$forUsers; 1565 return 0; # FIXME: maybe it should default to 1? 1566 } 1567 1568 # helper method that determines if a file is valid and returns a pretty error message 1569 sub checkFile ($) { 1570 my ($self, $file) = @_; 1571 1572 my $r = $self->r; 1573 my $ce = $r->ce; 1574 1575 return "No source file specified" unless $file; 1576 return "Problem source is drawn from a grouping set" if $file =~ /^group/; 1577 # $file = $ce->{courseDirs}->{templates} . '/' . $file unless $file =~ m|^/|; # bug: 1725 allows access to all files e.g. /etc/passwd 1578 $file = $ce->{courseDirs}->{templates} . '/' . $file ; # only files in template directory can be accessed 1579 1580 my $text = "This source file "; 1581 my $fileError; 1582 return "" if -e $file && -f $file && -r $file; 1583 return $text . "is not readable!" if -e $file && -f $file; 1584 return $text . "is a directory!" if -d $file; 1585 return $text . "does not exist!" unless -e $file; 1586 return $text . "is not a plain file!"; 1587 } 1588 1589 # don't show view options -- we provide display mode controls for headers/problems separately 1590 sub options { 1591 return ""; 1592 } 1593 1594 # Creates two separate tables, first of the headers, and the of the problems in a given set 1595 # If one or more users are specified in the "editForUser" param, only the data for those users 1596 # becomes editable, not all the data 1597 sub body { 1598 1599 my ($self) = @_; 1600 my $r = $self->r; 1601 my $db = $r->db; 1602 my $ce = $r->ce; 1603 my $authz = $r->authz; 1604 my $userID = $r->param('user'); 1605 my $urlpath = $r->urlpath; 1606 my $courseID = $urlpath->arg("courseID"); 1607 my $setID = $urlpath->arg("setID"); 1608 1609 ## we're now allowing setID to come in as setID,v# to edit a set 1610 ## version; catch this first 1611 my $editingSetVersion = 0; 1612 my $fullSetID = $setID; 1613 if ( $setID =~ /,v(\d+)$/ ) { 1614 $editingSetVersion = $1; 1615 $setID =~ s/,v(\d+)$//; 1616 } 1617 1618 my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; 1619 1620 my $userRecord = $db->getUser($userID) or die "No record for user $userID."; 1621 # Check permissions 1622 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 1623 unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); 1624 1625 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") 1626 unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); 1627 1628 my @editForUser = $r->param('editForUser'); 1629 1630 return CGI::div({class=>"ResultsWithError"}, "Versions of a set can only be " . 1631 "edited for one user at a time.") if ( $editingSetVersion && @editForUser != 1 ); 1632 1633 # Check that every user that we're editing for has a valid UserSet 1634 my @assignedUsers; 1635 my @unassignedUsers; 1636 if (scalar @editForUser) { 1637 foreach my $ID (@editForUser) { 1638 # DBFIXME iterator 1639 if ($db->getUserSet($ID, $setID)) { 1640 unshift @assignedUsers, $ID; 1641 } else { 1642 unshift @unassignedUsers, $ID; 1643 } 1644 } 1645 @editForUser = sort @assignedUsers; 1646 $r->param("editForUser", \@editForUser); 1647 1648 if (scalar @editForUser && scalar @unassignedUsers) { 1649 print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); 1650 } elsif (scalar @editForUser == 0) { 1651 print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); 1652 print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); 1653 } 1654 } 1655 1656 # some useful booleans 1657 my $forUsers = scalar(@editForUser); 1658 my $forOneUser = $forUsers == 1; 1659 1660 # and check that if we're editing a set version for a user, that 1661 # it exists as well 1662 if ( $editingSetVersion && ! $db->existsSetVersion( $editForUser[0], $setID, $editingSetVersion ) ) { 1663 return CGI::div({class=>"ResultsWithError"}, "The set-version ($setID, version $editingSetVersion) is not assigned to user $editForUser[0]."); 1664 } 1665 1666 # If you're editing for users, initially their records will be different but 1667 # if you make any changes to them they will be the same. 1668 # if you're editing for one user, the problems shown should be his/hers 1669 my $userToShow = $forUsers ? $editForUser[0] : $userID; 1670 1671 # a useful gateway variable 1672 my $isGatewaySet = ( $setRecord->assignment_type =~ /gateway/ ) ? 1 : 0; 1673 1674 # DBFIXME no need to get ID lists -- counts would be fine 1675 my $userCount = $db->listUsers(); 1676 my $setCount = $db->listGlobalSets(); # if $forOneUser; 1677 my $setUserCount = $db->countSetUsers($setID); 1678 # if $forOneUser; 1679 my $userSetCount = ($forOneUser && @editForUser) ? $db->countUserSets($editForUser[0]) : 0; 1680 1681 1682 my $editUsersAssignedToSetURL = $self->systemLink( 1683 $urlpath->newFromModule( 1684 "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", 1685 courseID => $courseID, setID => $setID)); 1686 my $editSetsAssignedToUserURL = $self->systemLink( 1687 $urlpath->newFromModule( 1688 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1689 courseID => $courseID, userID => $editForUser[0])) if $forOneUser; 1690 1691 1692 my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); 1693 my $fullsetDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $fullSetID); 1694 my $setDetailURL = $self->systemLink($fullsetDetailPage, authen=>0); 1695 1696 my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); 1697 my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; 1698 1699 $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; 1700 $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; 1701 1702 if ($forUsers) { 1703 ############################################## 1704 # calculate links for the users being edited: 1705 ############################################## 1706 my @userLinks = (); 1707 foreach my $userID (@editForUser) { 1708 my $u = $db->getUser($userID); 1709 my $email_address = $u->email_address; 1710 my $line = $u->last_name.", " . $u->first_name . " (" . 1711 CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id . 1712 "). "; 1713 if ( ! $editingSetVersion ) { 1714 $line .= "Assigned to "; 1715 my $editSetsAssignedToUserURL = $self->systemLink( 1716 $urlpath->newFromModule( 1717 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1718 courseID => $courseID, userID => $u->user_id)); 1719 $line .= CGI::a({href=>$editSetsAssignedToUserURL}, 1720 $self->setCountMessage($db->countUserSets($u->user_id), 1721 $setCount)); 1722 } else { 1723 my $editSetLink = $self->systemLink( $setDetailPage, 1724 params=>{effectiveUser=>$u->user_id, 1725 editForUser =>$u->user_id} ); 1726 $line .= "Edit set " . CGI::a({href=>$editSetLink},$setID) . 1727 " for this user."; 1728 } 1729 unshift @userLinks,$line; 1730 } 1731 @userLinks = sort @userLinks; 1732 1733 # handy messages when editing gateway sets 1734 my $gwmsg = ( $isGatewaySet && ! $editingSetVersion ) ? 1735 CGI::br() . CGI::em("To edit a specific student version of this set, " . 1736 "edit (all of) her/his assigned sets.") : ""; 1737 my $vermsg = ( $editingSetVersion ) ? ", test $editingSetVersion" : ""; 1738 1739 print CGI::table({border=>2,cellpadding=>10}, 1740 CGI::Tr({}, 1741 CGI::td([ 1742 "Editing problem set ".CGI::strong($setID . $vermsg)." data for these individual students:".CGI::br(). 1743 CGI::strong(join CGI::br(), @userLinks), 1744 CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set.") . $gwmsg, 1745 1746 ]) 1747 ) 1748 ); 1749 } else { 1750 print CGI::table({border=>2,cellpadding=>10}, 1751 CGI::Tr({}, 1752 CGI::td([ 1753 "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 1754 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", 1755 1756 ]) 1757 ) 1758 ); 1759 } 1760 1761 # handle renumbering of problems if necessary 1762 print CGI::a({name=>"problems"}); 1763 1764 my %newProblemNumbers = (); 1765 my $maxProblemNumber = -1; 1766 for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { 1767 $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); 1768 $maxProblemNumber = $jj if $jj > $maxProblemNumber; 1769 } 1770 1771 my $forceRenumber = $r->param('force_renumber') || 0; 1772 handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); 1773 1774 my %properties = %{ FIELD_PROPERTIES() }; 1775 1776 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1777 my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; 1778 push @active_modes, 'None'; 1779 my $default_header_mode = $r->param('header.displaymode') || 'None'; 1780 my $default_problem_mode = $r->param('problem.displaymode') || 'None'; 1781 1782 ##################################################################### 1783 # Browse available header/problem files 1784 ##################################################################### 1785 1786 my $templates = $r->ce->{courseDirs}->{templates}; 1787 my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); 1788 1789 my @headerFileList = listFilesRecursive( 1790 $templates, 1791 qr/header.*\.pg$/i, # match these files 1792 qr/^(?:$skip|CVS)$/, # prune these directories 1793 0, # match against file name only 1794 1, # prune against path relative to $templates 1795 ); 1796 1797 # this just takes too much time to search 1798 # my @problemFileList = listFilesRecursive( 1799 # $templates, 1800 # qr/\.pg$/i, # problem files don't say problem 1801 # qr/^(?:$skip|CVS)$/, # prune these directories 1802 # 0, # match against file name only 1803 # 1, # prune against path relative to $templates 1804 # ); 1805 1806 # Display a useful warning message 1807 if ($forUsers) { 1808 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . 1809 ($forOneUser ? "" : "s") . " listed above.")); 1810 } else { 1811 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); 1812 } 1813 1814 print CGI::start_form({method=>"POST", action=>$setDetailURL}); 1815 print $self->hiddenEditForUserFields(@editForUser); 1816 print $self->hidden_authen_fields; 1817 print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); 1818 print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); 1819 1820 # spacing 1821 print CGI::p(); 1822 1823 ##################################################################### 1824 # Display general set information 1825 ##################################################################### 1826 1827 print CGI::start_table({border=>1, cellpadding=>4}); 1828 print CGI::Tr({}, CGI::th({}, [ 1829 "General Information", 1830 ])); 1831 1832 # this is kind of a hack -- we need to get a user record here, so we can 1833 # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so 1834 # FieldHTML doesn't have to fetch it itself. 1835 my $userSetRecord = $db->getUserSet($userToShow, $setID); 1836 1837 my $templateUserSetRecord; 1838 # send in the set version if we're editing for versions 1839 if ( $editingSetVersion ) { 1840 $templateUserSetRecord = $userSetRecord; 1841 $userSetRecord = $db->getSetVersion( $userToShow, $setID, $editingSetVersion ); 1842 } 1843 1844 print CGI::Tr({}, CGI::td({}, [ 1845 $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), 1846 ])); 1847 print CGI::end_table(); 1848 1849 # spacing 1850 print CGI::p(); 1851 1852 1853 ##################################################################### 1854 # Display header information 1855 ##################################################################### 1856 my @headers = @{ HEADER_ORDER() }; 1857 my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); 1858 my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); 1859 my @headerFiles = map { $setRecord->{$_} } @headers; 1860 if (scalar @headers and not $forUsers) { 1861 1862 print CGI::start_table({border=>1, cellpadding=>4}); 1863 print CGI::Tr({}, CGI::th({}, [ 1864 "Headers", 1865 # "Data", 1866 "Display Mode: " . 1867 CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. 1868 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1869 ])); 1870 1871 my %header_html; 1872 1873 my %error; 1874 my $this_set = $db->getMergedSet($userToShow, $setID); 1875 my $guaranteed_set = $this_set; 1876 if ( ! $guaranteed_set ) { 1877 # in the header loop we need to have a set that 1878 # we know exists, so if the getMergedSet failed 1879 # (that is, the set isn't assigned to the 1880 # the current user), we get the global set instead 1881 # $guaranteed_set = $db->getGlobalSet( $setID ); 1882 $guaranteed_set = $setRecord; 1883 } 1884 1885 foreach my $header (@headers) { 1886 1887 my $headerFile = $r->param("set.$setID.$header") || $setRecord->{$header} || $headerDefaults{$header}; 1888 1889 $error{$header} = $self->checkFile($headerFile); 1890 1891 unless ($error{$header}) { 1892 my @temp = renderProblems( 1893 r=> $r, 1894 user => $db->getUser($userToShow), 1895 displayMode=> $default_header_mode, 1896 problem_number=> 0, 1897 this_set => $this_set, 1898 problem_list => [$headerFile], 1899 ); 1900 $header_html{$header} = $temp[0]; 1901 } 1902 } 1903 1904 foreach my $header (@headers) { 1905 1906 my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); 1907 my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $header, make_local_copy => 1 }); 1908 1909 my $viewHeaderPage = $urlpath->new(type => $headerModules{$header}, args => { courseID => $courseID, setID => $setID }); 1910 my $viewHeaderLink = $self->systemLink($viewHeaderPage); 1911 1912 # this is a bit of a hack; the set header isn't shown 1913 # for gateway tests, and we run into trouble trying to 1914 # edit/view it in this context, so we don't show this 1915 # field for gateway tests 1916 if ( $header eq 'set_header' && 1917 $guaranteed_set->assignment_type =~ /gateway/ ) { 1918 print CGI::Tr({}, CGI::td({}, 1919 [ "Set Header", 1920 "Set headers are not used in " . 1921 "display of gateway tests."])); 1922 next; 1923 } 1924 1925 1926 print CGI::Tr({}, CGI::td({}, [ 1927 CGI::start_table({border => 0, cellpadding => 0}) . 1928 CGI::Tr({}, CGI::td({}, $properties{$header}->{name})) . 1929 CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . 1930 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . 1931 # CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "defaultHeader", value => $header, label => "Use Default"}))) . 1932 CGI::end_table(), 1933 # "", 1934 # CGI::input({ name => "set.$setID.$header", value => $setRecord->{$header}, size => 50}) . 1935 # join ("\n", $self->FieldHTML($userToShow, $setID, $problemID, "source_file")) . 1936 # CGI::br() . CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}), 1937 1938 comboBox({ 1939 name => "set.$setID.$header", 1940 request => $r, 1941 default => $r->param("set.$setID.$header") || $setRecord->{$header}, 1942 multiple => 0, 1943 values => ["", @headerFileList], 1944 labels => { "" => "Use Default Header File" }, 1945 }) . 1946 ($error{$header} ? 1947 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$header}) 1948 : CGI::div({class=> "RenderSolo"}, $header_html{$header}->{body_text}) 1949 ), 1950 ])); 1951 } 1952 1953 print CGI::end_table(); 1954 } else { 1955 print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); 1956 } 1957 1958 # spacing 1959 print CGI::p(); 1960 1961 1962 ##################################################################### 1963 # Display problem information 1964 ##################################################################### 1965 1966 my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); 1967 1968 # DBFIXME use iterators instead of getting all at once 1969 1970 # get global problem records for all problems in one go 1971 my %GlobalProblems; 1972 my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; 1973 # DBFIXME shouldn't need to get key list here 1974 @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); 1975 1976 # if needed, get user problem records for all problems in one go 1977 my (%UserProblems, %MergedProblems); 1978 if ($forOneUser) { 1979 my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; 1980 # DBFIXME shouldn't need to get key list here 1981 @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); 1982 if ( ! $editingSetVersion ) { 1983 @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); 1984 } else { 1985 my @userversionKeypartsRef = map { [$editForUser[0], $setID, $editingSetVersion, $_] } @problemIDList; 1986 @MergedProblems{@problemIDList} = $db->getMergedProblemVersions(@userversionKeypartsRef); 1987 } 1988 } 1989 1990 if (scalar @problemIDList) { 1991 1992 print CGI::start_table({border=>1, cellpadding=>4}); 1993 print CGI::Tr({}, CGI::th({}, [ 1994 "Problems", 1995 "Data", 1996 "Display Mode: " . 1997 CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. 1998 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1999 ])); 2000 2001 my %shownYet; 2002 my $repeatFile; 2003 2004 foreach my $problemID (@problemIDList) { 2005 2006 my $problemRecord; 2007 if ($forOneUser) { 2008 #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); 2009 $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam 2010 } else { 2011 #$problemRecord = $db->getGlobalProblem($setID, $problemID); 2012 $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam 2013 } 2014 2015 #$self->addgoodmessage(""); 2016 #$self->addbadmessage($problemRecord->toString()); 2017 2018 # when we're editing a set version, we want to be sure to 2019 # use the merged problem in the edit, because we could 2020 # be using problem groups (for which the problem is generated 2021 # and then stored in the problem version) 2022 my $problemToShow = ( $editingSetVersion ) ? 2023 $MergedProblems{$problemID} : $UserProblems{$problemID}; 2024 2025 my ( $editProblemPage, $editProblemLink, $viewProblemPage, 2026 $viewProblemLink ); 2027 if ( $isGatewaySet ) { 2028 $editProblemPage = $urlpath->new(type =>'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID }); 2029 $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 2030 $viewProblemPage = 2031 $urlpath->new(type =>'gateway_quiz', 2032 args => { courseID => $courseID, 2033 setID => "Undefined_Set", 2034 problemID => "1" } ); 2035 2036 my $seed = $problemToShow ? $problemToShow->problem_seed : ""; 2037 my $file = $problemToShow ? $problemToShow->source_file : 2038 $GlobalProblems{$problemID}->source_file; 2039 2040 $viewProblemLink = 2041 $self->systemLink( $viewProblemPage, 2042 params => { effectiveUser => 2043 ($forOneUser ? $editForUser[0] : $userID), 2044 problemSeed => $seed, 2045 sourceFilePath => $file }); 2046 } else { 2047 $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID }); 2048 $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 2049 # FIXME: should we have an "act as" type link here when editing for multiple users? 2050 $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 2051 $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); 2052 } 2053 2054 ###----- 2055 ### The array @fields never gets used in the following, so 2056 ### I'm commenting it out. If there's a reason it should 2057 ### be here, someone else can add it back in and maybe 2058 ### comment why. Thanks, Gavin. -glarose 6/19/08 2059 ### my @fields = @{ PROBLEM_FIELDS() }; 2060 ### push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser; 2061 ###----- 2062 2063 my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; 2064 2065 # warn of repeat problems 2066 if (defined $shownYet{$problemFile}) { 2067 $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; 2068 } else { 2069 $shownYet{$problemFile} = $problemID; 2070 $repeatFile = ""; 2071 } 2072 2073 my $error = $self->checkFile($problemFile); 2074 my $this_set = $db->getMergedSet($userToShow, $setID); 2075 my @problem_html; 2076 unless ($error) { 2077 @problem_html = renderProblems( 2078 r=> $r, 2079 user => $db->getUser($userToShow), 2080 displayMode=> $default_problem_mode, 2081 problem_number=> $problemID, 2082 this_set => $this_set, 2083 problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, 2084 problem_list => [$problemRecord->source_file], 2085 ); 2086 } 2087 2088 # we want to show the "Try It" and "Edit It" links if there's a 2089 # well defined problem to view; this is when we're editing a 2090 # homework set, or if we're editing a gateway set version, or 2091 # if we're editing a gateway set and the problem is not a 2092 # group problem 2093 my $showLinks = ( ! $isGatewaySet || 2094 ( $editingSetVersion || $problemFile !~ /^group/ )); 2095 2096 2097 print CGI::Tr({}, CGI::td({}, [ 2098 CGI::start_table({border => 0, cellpadding => 1}) . 2099 CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . 2100 CGI::Tr({}, CGI::td({}, 2101 $showLinks ? CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it") : "" )) . 2102 CGI::Tr({}, CGI::td({}, 2103 $showLinks ? CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")) : "" )) . 2104 ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . 2105 # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . 2106 ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . 2107 CGI::end_table(), 2108 $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $problemToShow, $isGatewaySet), 2109 # A comprehensive list of problems is just TOO big to be handled well 2110 # comboBox({ 2111 # name => "set.$setID.$problemID", 2112 # request => $r, 2113 # default => $problemRecord->{problem_id}, 2114 # multiple => 0, 2115 # values => \@problemFileList, 2116 # }) . 2117 2118 join ("\n", $self->FieldHTML( 2119 $userToShow, 2120 $setID, 2121 $problemID, 2122 $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam 2123 $problemToShow, # pass previously fetched user record to FieldHTML --sam 2124 "source_file" 2125 )) . 2126 CGI::br() . 2127 ($error ? 2128 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) 2129 : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) 2130 ) . 2131 ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), 2132 ])); 2133 } 2134 2135 2136 # print final lines 2137 print CGI::end_table(); 2138 print CGI::checkbox({ 2139 label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", 2140 name=>"force_renumber", value=>"1"}); 2141 print CGI::p(<<EOF); 2142 Any time problem numbers are intentionally changed, the problems will 2143 always be renumbered consecutively, starting from one. When deleting 2144 problems, gaps will be left in the numbering unless the box above is 2145 checked. 2146 EOF 2147 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()); 2148 print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); 2149 2150 } else { 2151 print CGI::p(CGI::b("This set doesn't contain any problems yet.")); 2152 } 2153 # always allow one to add a new problem, unless we're editing a set version 2154 if ( ! $editingSetVersion ) { 2155 print CGI::checkbox({ label=> "Add", 2156 name=>"add_blank_problem", value=>"1"} 2157 ),CGI::input({ 2158 name=>"add_n_problems", 2159 size=>2, 2160 value=>1 }, 2161 "blank problem template(s) to end of homework set" 2162 ); 2163 } 2164 print CGI::br(),CGI::br(), 2165 CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), 2166 CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), 2167 "(Any unsaved changes will be lost.)"; 2168 2169 #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); 2170 #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); 2171 # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME 2172 #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); 2173 2174 print CGI::end_form(); 2175 2176 return ""; 2177 } 2178 2179 1; 2180 2181 =head1 AUTHOR 2182 2183 Written by Robert Van Dam, toenail (at) cif.rochester.edu 2184 2185 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |