Parent Directory
| 
Revision Log
changed all references to Safe to WWSafe just to be "safe" fixed security hole in file paths for Problem Set Detail uploaded changes to setmaker 2 from dg_dev. includes holding shift key down (before) you move a file in order to move it rather than to add it.
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 832 # primarily saves any changes into the correct set or problem records (global vs user) 833 # also deals with deleting or rearranging problems 834 sub initialize { 835 my ($self) = @_; 836 my $r = $self->r; 837 my $db = $r->db; 838 my $ce = $r->ce; 839 my $authz = $r->authz; 840 my $user = $r->param('user'); 841 my $setID = $r->urlpath->arg("setID"); 842 843 ## we're now allowing setID to come in as setID,v# to edit a set 844 ## version; catch this first 845 my $editingSetVersion = 0; 846 if ( $setID =~ /,v(\d+)$/ ) { 847 $editingSetVersion = $1; 848 $setID =~ s/,v(\d+)$//; 849 } 850 851 my $setRecord = $db->getGlobalSet($setID); # checked 852 die "global set $setID not found." unless $setRecord; 853 854 $self->{set} = $setRecord; 855 my @editForUser = $r->param('editForUser'); 856 # some useful booleans 857 my $forUsers = scalar(@editForUser); 858 my $forOneUser = $forUsers == 1; 859 860 # Check permissions 861 return unless ($authz->hasPermissions($user, "access_instructor_tools")); 862 return unless ($authz->hasPermissions($user, "modify_problem_sets")); 863 864 ## if we're editing a versioned set, it only makes sense to be 865 ## editing it for one user 866 return if ( $editingSetVersion && ! $forOneUser ); 867 868 my %properties = %{ FIELD_PROPERTIES() }; 869 870 # takes a hash of hashes and inverts it 871 my %undoLabels; 872 foreach my $key (keys %properties) { 873 %{ $undoLabels{$key} } = map { $properties{$key}->{labels}->{$_} => $_ } keys %{ $properties{$key}->{labels} }; 874 } 875 876 # Unfortunately not everyone uses Javascript enabled browsers so 877 # we must fudge the information coming from the ComboBoxes 878 # Since the textfield and menu both have the same name, we get an array of two elements 879 # We then reset the param to the first if its not-empty or the second (empty or not). 880 foreach ( @{ HEADER_ORDER() } ) { 881 my @values = $r->param("set.$setID.$_"); 882 my $value = $values[0] || $values[1] || ""; 883 $r->param("set.$setID.$_", $value); 884 } 885 886 ##################################################################### 887 # Check date information 888 ##################################################################### 889 890 my ($open_date, $due_date, $answer_date); 891 my $error = 0; 892 if (defined $r->param('submit_changes')) { 893 my @names = ("open_date", "due_date", "answer_date"); 894 895 my %dates = map { $_ => $r->param("set.$setID.$_") } @names; 896 %dates = map { 897 my $unlabel = $undoLabels{$_}->{$dates{$_}}; 898 $_ => defined $unlabel ? $setRecord->$_ : $self->parseDateTime($dates{$_}) 899 } @names; 900 901 ($open_date, $due_date, $answer_date) = map { $dates{$_} } @names; 902 903 if ($answer_date < $due_date || $answer_date < $open_date) { 904 $self->addbadmessage("Answers cannot be made available until on or after the due date!"); 905 $error = $r->param('submit_changes'); 906 } 907 908 if ($due_date < $open_date) { 909 $self->addbadmessage("Answers cannot be due until on or after the open date!"); 910 $error = $r->param('submit_changes'); 911 } 912 913 # make sure the dates are not more than 10 years in the future 914 my $curr_time = time; 915 my $seconds_per_year = 31_556_926; 916 my $cutoff = $curr_time + $seconds_per_year*10; 917 if ($open_date > $cutoff) { 918 $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); 919 $error = $r->param('submit_changes'); 920 } 921 if ($due_date > $cutoff) { 922 $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); 923 $error = $r->param('submit_changes'); 924 } 925 if ($answer_date > $cutoff) { 926 $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); 927 $error = $r->param('submit_changes'); 928 } 929 930 } 931 if ($error) { 932 $self->addbadmessage("No changes were saved!"); 933 } 934 935 if (defined $r->param('submit_changes') && !$error) { 936 937 #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam 938 939 ##################################################################### 940 # Save general set information (including headers) 941 ##################################################################### 942 943 if ($forUsers) { 944 # note that we don't deal with the proctor user 945 # fields here, with the assumption that it can't 946 # be possible to change them for users. this is 947 # not the most robust treatment of the problem 948 # (FIXME) 949 950 # DBFIXME use a WHERE clause, iterator 951 my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser); 952 # if we're editing a set version, we want to edit 953 # edit that instead of the userset, so get it 954 # too. 955 my $userSet = $userRecords[0]; 956 my $setVersion = 0; 957 if ( $editingSetVersion ) { 958 $setVersion = 959 $db->getSetVersion($editForUser[0], 960 $setID, 961 $editingSetVersion); 962 @userRecords = ( $setVersion ); 963 } 964 965 foreach my $record (@userRecords) { 966 foreach my $field ( @{ SET_FIELDS() } ) { 967 next unless canChange($forUsers, $field); 968 my $override = $r->param("set.$setID.$field.override"); 969 970 if (defined $override && $override eq $field) { 971 972 my $param = $r->param("set.$setID.$field"); 973 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 974 my $unlabel = $undoLabels{$field}->{$param}; 975 $param = $unlabel if defined $unlabel; 976 # $param = $undoLabels{$field}->{$param} || $param; 977 if ($field =~ /_date/) { 978 $param = $self->parseDateTime($param) unless defined $unlabel; 979 } 980 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { 981 $param = $param*$properties{$field}->{convertby}; 982 } 983 # special case; does field fill in multiple values? 984 if ( $field =~ /:/ ) { 985 my @values = split(/:/, $param); 986 my @fields = split(/:/, $field); 987 for ( my $i=0; $i<@values; $i++ ) { 988 my $f=$fields[$i]; 989 $record->$f($values[$i]); 990 } 991 } else { 992 $record->$field($param); 993 } 994 } else { 995 #################### 996 # FIXME: allow one selector to set multiple fields 997 # 998 if ( $field =~ /:/ ) { 999 foreach my $f ( split(/:/, $field) ) { 1000 $record->$f(undef); 1001 } 1002 } else { 1003 $record->$field(undef); 1004 } 1005 } 1006 1007 } 1008 #################### 1009 # FIXME: this is replaced by our allowing multiple fields to be set by one selector 1010 # a check for hiding scores: if we have 1011 # $set->hide_score eq 'N', we also want 1012 # $set->hide_score_by_problem eq 'N' 1013 # if ( $record->hide_score eq 'N' ) { 1014 # $record->hide_score_by_problem('N'); 1015 # } 1016 #################### 1017 if ( $editingSetVersion ) { 1018 $db->putSetVersion( $record ); 1019 } else { 1020 $db->putUserSet($record); 1021 } 1022 } 1023 1024 ####################################################### 1025 # Save IP restriction Location information 1026 ####################################################### 1027 # FIXME: it would be nice to have this in the field values 1028 # hash, so that we don't have to assume that we can 1029 # override this information for users 1030 1031 ## should we allow resetting set locations for set versions? this 1032 ## requires either putting in a new set of database routines 1033 ## to deal with the versioned setID, or fudging it at this end 1034 ## by manually putting in the versioned ID setID,v#. neither 1035 ## of these seems desirable, so for now it's not allowed 1036 if ( ! $editingSetVersion ) { 1037 if ( $r->param("set.$setID.selected_ip_locations.override") ) { 1038 foreach my $record ( @userRecords ) { 1039 my $userID = $record->user_id; 1040 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1041 my @userSetLocations = $db->listUserSetLocations($userID,$setID); 1042 my @addSetLocations = (); 1043 my @delSetLocations = (); 1044 foreach my $loc ( @selectedLocations ) { 1045 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) ); 1046 } 1047 foreach my $loc ( @userSetLocations ) { 1048 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1049 } 1050 # then update the user set_locations 1051 foreach ( @addSetLocations ) { 1052 my $Loc = $db->newUserSetLocation; 1053 $Loc->set_id( $setID ); 1054 $Loc->user_id( $userID ); 1055 $Loc->location_id($_); 1056 $db->addUserSetLocation($Loc); 1057 } 1058 foreach ( @delSetLocations ) { 1059 $db->deleteUserSetLocation($userID,$setID,$_); 1060 } 1061 } 1062 } else { 1063 # if override isn't selected, then we want 1064 # to be sure that there are no 1065 # set_locations_user entries setting around 1066 foreach my $record ( @userRecords ) { 1067 my $userID = $record->user_id; 1068 my @userLocations = $db->listUserSetLocations($userID,$setID); 1069 foreach ( @userLocations ) { 1070 $db->deleteUserSetLocation($userID,$setID,$_); 1071 } 1072 } 1073 } 1074 } 1075 } else { 1076 foreach my $field ( @{ SET_FIELDS() } ) { 1077 next unless canChange($forUsers, $field); 1078 1079 my $param = $r->param("set.$setID.$field"); 1080 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1081 1082 my $unlabel = $undoLabels{$field}->{$param}; 1083 $param = $unlabel if defined $unlabel; 1084 if ($field =~ /_date/) { 1085 $param = $self->parseDateTime($param) unless defined $unlabel; 1086 } 1087 if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby} && $param) { 1088 $param = $param*$properties{$field}->{convertby}; 1089 } 1090 # special case; does field fill in multiple values? 1091 if ( $field =~ /:/ ) { 1092 my @values = split(/:/, $param); 1093 my @fields = split(/:/, $field); 1094 for ( my $i=0; $i<@fields; $i++ ) { 1095 my $f = $fields[$i]; 1096 $setRecord->$f($values[$i]); 1097 } 1098 } else { 1099 $setRecord->$field($param); 1100 } 1101 } 1102 #################### 1103 # FIXME: this is replaced by our setting both hide_score and hide_score_by_problem 1104 # with a single drop down 1105 # 1106 # # a check for hiding scores: if we have 1107 # # $set->hide_score eq 'N', we also want 1108 # # $set->hide_score_by_problem eq 'N', and if it's 1109 # # changed to 'Y' and hide_score_by_problem is Null, 1110 # # give it a value 'N' 1111 # if ( $setRecord->hide_score eq 'N' || 1112 # ( ! defined($setRecord->hide_score_by_problem) || 1113 # $setRecord->hide_score_by_problem eq '' ) ) { 1114 # $setRecord->hide_score_by_problem('N'); 1115 # } 1116 #################### 1117 $db->putGlobalSet($setRecord); 1118 1119 ####################################################### 1120 # Save IP restriction Location information 1121 ####################################################### 1122 1123 if ( defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No' ) { 1124 my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); 1125 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1126 my @addSetLocations = (); 1127 my @delSetLocations = (); 1128 foreach my $loc ( @selectedLocations ) { 1129 push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @globalSetLocations ) ); 1130 } 1131 foreach my $loc ( @globalSetLocations ) { 1132 push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); 1133 } 1134 # then update the global set_locations 1135 foreach ( @addSetLocations ) { 1136 my $Loc = $db->newGlobalSetLocation; 1137 $Loc->set_id( $setID ); 1138 $Loc->location_id($_); 1139 $db->addGlobalSetLocation($Loc); 1140 } 1141 foreach ( @delSetLocations ) { 1142 $db->deleteGlobalSetLocation($setID,$_); 1143 } 1144 } else { 1145 my @globalSetLocations = $db->listGlobalSetLocations($setID); 1146 foreach ( @globalSetLocations ) { 1147 $db->deleteGlobalSetLocation($setID,$_); 1148 } 1149 } 1150 1151 ####################################################### 1152 # Save proctored problem proctor user information 1153 ####################################################### 1154 if ($r->param("set.$setID.restricted_login_proctor_password") && 1155 $setRecord->assignment_type eq 'proctored_gateway') { 1156 # in this case we're adding a set-level proctor 1157 # or updating the password 1158 1159 my $procID = "set_id:$setID"; 1160 my $pass = $r->param("set.$setID.restricted_login_proctor_password"); 1161 # should we carefully check in this case that 1162 # the user and password exist? the code 1163 # in the add stanza is pretty careful to 1164 # be sure that there's a one-to-one 1165 # correspondence between the existence of 1166 # the user and the setting of the set 1167 # restricted_login_proctor field, so we 1168 # assume that just checking the latter 1169 # here is sufficient. 1170 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1171 # in this case we already have a set 1172 # level proctor, and so should be 1173 # resetting the password 1174 if ( $pass ne '********' ) { 1175 # then we submitted a new 1176 # password, so save it 1177 my $dbPass; 1178 eval { $dbPass = $db->getPassword($procID) }; 1179 if ( $@ ) { 1180 $self->addbadmessage("Error getting old set-proctor password from the database: $@. No update to the password was done."); 1181 } else { 1182 $dbPass->password(cryptPassword($pass)); 1183 $db->putPassword($dbPass); 1184 } 1185 } 1186 1187 } else { 1188 $setRecord->restricted_login_proctor('Yes'); 1189 my $procUser = $db->newUser(); 1190 $procUser->user_id($procID); 1191 $procUser->last_name("Proctor"); 1192 $procUser->first_name("Login"); 1193 $procUser->student_id("loginproctor"); 1194 $procUser->status($ce->status_name_to_abbrevs('Proctor')); 1195 my $procPerm = $db->newPermissionLevel; 1196 $procPerm->user_id($procID); 1197 $procPerm->permission($ce->{userRoles}->{login_proctor}); 1198 my $procPass = $db->newPassword; 1199 $procPass->user_id($procID); 1200 $procPass->password(cryptPassword($pass)); 1201 # put these into the database 1202 eval { $db->addUser($procUser) }; 1203 if ( $@ ) { 1204 $self->addbadmessage("Error " . 1205 "adding set-level " . 1206 "proctor: $@"); 1207 } else { 1208 $db->addPermissionLevel($procPerm); 1209 $db->addPassword($procPass); 1210 } 1211 1212 # and set the restricted_login_proctor 1213 # set field 1214 $db->putGlobalSet( $setRecord ); 1215 } 1216 1217 } else { 1218 # if the parameter isn't set, or if the assignment 1219 # type is not 'proctored_gateway', then we need to be 1220 # sure that there's no set-level proctor defined 1221 if ( $setRecord->restricted_login_proctor eq 'Yes' ) { 1222 1223 $setRecord->restricted_login_proctor('No'); 1224 $db->deleteUser( "set_id:$setID" ); 1225 $db->putGlobalSet( $setRecord ); 1226 1227 } 1228 } 1229 } 1230 1231 ##################################################################### 1232 # Save problem information 1233 ##################################################################### 1234 1235 # DBFIXME use a WHERE clause, iterator? 1236 my @problemIDs = sort { $a <=> $b } $db->listGlobalProblems($setID);; 1237 my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); 1238 foreach my $problemRecord (@problemRecords) { 1239 my $problemID = $problemRecord->problem_id; 1240 die "Global problem $problemID for set $setID not found." unless $problemRecord; 1241 1242 if ($forUsers) { 1243 # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page 1244 # So we only need to make changes to the UserProblem record and only then if we are overriding a value 1245 # in the GlobalProblem record or for fields unique to the UserProblem record. 1246 1247 my @userIDs = @editForUser; 1248 1249 my @userProblemRecords; 1250 if ( ! $editingSetVersion ) { 1251 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1252 # DBFIXME where clause? iterator? 1253 @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1254 } else { 1255 ## (we know that we're only editing for one user) 1256 @userProblemRecords = 1257 ( $db->getMergedProblemVersion( $userIDs[0], $setID, $editingSetVersion, $problemID ) ); 1258 } 1259 1260 foreach my $record (@userProblemRecords) { 1261 1262 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1263 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1264 next unless canChange($forUsers, $field); 1265 1266 my $override = $r->param("problem.$problemID.$field.override"); 1267 if (defined $override && $override eq $field) { 1268 1269 my $param = $r->param("problem.$problemID.$field"); 1270 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1271 my $unlabel = $undoLabels{$field}->{$param}; 1272 $param = $unlabel if defined $unlabel; 1273 #protect exploits with source_file 1274 if ($field eq 'source_file') { 1275 $param =~ s|^/||; # prevent access to files above template 1276 $param =~ s|\.\.||g; # prevent access to files above template 1277 } 1278 1279 $changed ||= changed($record->$field, $param); 1280 $record->$field($param); 1281 } else { 1282 $changed ||= changed($record->$field, undef); 1283 $record->$field(undef); 1284 } 1285 1286 } 1287 1288 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1289 next unless canChange($forUsers, $field); 1290 1291 my $param = $r->param("problem.$problemID.$field"); 1292 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1293 my $unlabel = $undoLabels{$field}->{$param}; 1294 $param = $unlabel if defined $unlabel; 1295 #protect exploits with source_file 1296 if ($field eq 'source_file') { 1297 $param =~ s|^/||; # prevent access to files above template 1298 $param =~ s|\.\.||g; # prevent access to files above template 1299 } 1300 1301 $changed ||= changed($record->$field, $param); 1302 $record->$field($param); 1303 } 1304 if ( ! $editingSetVersion ) { 1305 $db->putUserProblem($record) if $changed; 1306 } else { 1307 $db->putProblemVersion($record) if $changed; 1308 } 1309 } 1310 } else { 1311 # Since we're editing for ALL set users, we will make changes to the GlobalProblem record. 1312 # We may also have instances where a field is unique to the UserProblem record but we want 1313 # all users to (at least initially) have the same value 1314 1315 # this only edits a globalProblem record 1316 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1317 foreach my $field ( @{ PROBLEM_FIELDS() } ) { 1318 next unless canChange($forUsers, $field); 1319 1320 my $param = $r->param("problem.$problemID.$field"); 1321 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1322 my $unlabel = $undoLabels{$field}->{$param}; 1323 $param = $unlabel if defined $unlabel; 1324 1325 #protect exploits with source_file 1326 if ($field eq 'source_file') { 1327 $param =~ s|^/||; # prevent access to files above template 1328 $param =~ s|\.\.||g; # prevent access to files above template 1329 } 1330 $changed ||= changed($problemRecord->$field, $param); 1331 $problemRecord->$field($param); 1332 } 1333 $db->putGlobalProblem($problemRecord) if $changed; 1334 1335 1336 # sometimes (like for status) we might want to change an attribute in 1337 # the userProblem record for every assigned user 1338 # However, since this data is stored in the UserProblem records, 1339 # it won't be displayed once its been changed and if you hit "Save Changes" again 1340 # it gets erased 1341 1342 # So we'll enforce that there be something worth putting in all the UserProblem records 1343 # This also will make hitting "Save Changes" on the global page MUCH faster 1344 my %useful; 1345 foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { 1346 my $param = $r->param("problem.$problemID.$field"); 1347 $useful{$field} = 1 if defined $param and $param ne ""; 1348 } 1349 1350 if (keys %useful) { 1351 # DBFIXME where clause, iterator 1352 my @userIDs = $db->listProblemUsers($setID, $problemID); 1353 my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; 1354 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1355 foreach my $record (@userProblemRecords) { 1356 my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses 1357 foreach my $field ( keys %useful ) { 1358 next unless canChange($forUsers, $field); 1359 1360 my $param = $r->param("problem.$problemID.$field"); 1361 $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; 1362 my $unlabel = $undoLabels{$field}->{$param}; 1363 $param = $unlabel if defined $unlabel; 1364 $changed ||= changed($record->$field, $param); 1365 $record->$field($param); 1366 } 1367 $db->putUserProblem($record) if $changed; 1368 } 1369 } 1370 } 1371 } 1372 1373 # Mark the specified problems as correct for all users (not applicable when editing a set 1374 # version, because this only shows up when editing for users or editing the 1375 # global set/problem, not for one user) 1376 foreach my $problemID ($r->param('markCorrect')) { 1377 # DBFIXME where clause, iterator 1378 my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID)); 1379 # if the set is not a gateway set, this requires going through the 1380 # user_problems and resetting their status; if it's a gateway set, 1381 # then we have to go through every *version* of every user_problem. 1382 # it may be that there is an argument for being able to get() all 1383 # problem versions for all users in one database call. The current 1384 # code may be slow for large classes. 1385 if ( $setRecord->assignment_type !~ /gateway/ ) { 1386 my @userProblemRecords = $db->getUserProblems(@userProblemIDs); 1387 foreach my $record (@userProblemRecords) { 1388 if (defined $record && ($record->status eq "" || $record->status < 1)) { 1389 $record->status(1); 1390 $record->attempted(1); 1391 $db->putUserProblem($record); 1392 } 1393 } 1394 } else { 1395 my @userIDs = ( $forUsers ) ? @editForUser : $db->listProblemUsers($setID, $problemID); 1396 foreach my $uid ( @userIDs ) { 1397 my @versions = $db->listSetVersions( $uid, $setID ); 1398 my @userProblemVersionIDs = 1399 map{ [ $uid, $setID, $_, $problemID ]} @versions; 1400 my @userProblemVersionRecords = $db->getProblemVersions(@userProblemVersionIDs); 1401 foreach my $record (@userProblemVersionRecords) { 1402 if (defined $record && ($record->status eq "" || $record->status < 1)) { 1403 $record->status(1); 1404 $record->attempted(1); 1405 $db->putProblemVersion($record); 1406 } 1407 } 1408 } 1409 } 1410 } 1411 1412 # Delete all problems marked for deletion (not applicable when editing 1413 # for users) 1414 foreach my $problemID ($r->param('deleteProblem')) { 1415 $db->deleteGlobalProblem($setID, $problemID); 1416 } 1417 1418 ##################################################################### 1419 # Add blank problem if needed 1420 ##################################################################### 1421 if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { 1422 # get number of problems to add and clean the entry 1423 my $newBlankProblems = (defined($r->param("add_n_problems")) ) ? $r->param("add_n_problems") :1; 1424 $newBlankProblems = int($newBlankProblems); 1425 my $MAX_NEW_PROBLEMS = 20; 1426 if ($newBlankProblems >=1 and $newBlankProblems <= $MAX_NEW_PROBLEMS ) { 1427 foreach my $newProb (1..$newBlankProblems) { 1428 my $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setID)); 1429 ################################################## 1430 # make local copy of the blankProblem 1431 ################################################## 1432 my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; 1433 my $problemContents = WeBWorK::Utils::readFile($blank_file_path); 1434 my $new_file_path = "set$setID/".BLANKPROBLEM(); 1435 my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); 1436 local(*TEMPFILE); 1437 open(TEMPFILE, ">$fullPath") or warn "Can't write to file $fullPath"; 1438 print TEMPFILE $problemContents; 1439 close(TEMPFILE); 1440 1441 ################################################# 1442 # Update problem record 1443 ################################################# 1444 my $problemRecord = $self->addProblemToSet( 1445 setName => $setID, 1446 sourceFile => $new_file_path, 1447 problemID => $targetProblemNumber, #added to end of set 1448 ); 1449 $self->assignProblemToAllSetUsers($problemRecord); 1450 $self->addgoodmessage("Added $new_file_path to ". $setID. " as problem $targetProblemNumber") ; 1451 } 1452 } else { 1453 $self->addbadmessage("Could not add $newBlankProblems problems to this set. The number must be between 1 and $MAX_NEW_PROBLEMS"); 1454 } 1455 } 1456 1457 # Sets the specified header to "" so that the default file will get used. 1458 foreach my $header ($r->param('defaultHeader')) { 1459 $setRecord->$header("defaultHeader"); 1460 } 1461 } 1462 1463 # Leftover code from when there were up/down buttons 1464 1465 # } else { 1466 # # Look for up and down buttons 1467 # my $index = 2; 1468 # while ($index <= scalar @problemList) { 1469 # if (defined $r->param("move.up.$index.x")) { 1470 # moveme($index-1, $db, $setID, @problemList); 1471 # } 1472 # $index++; 1473 # } 1474 # $index = 1; 1475 # 1476 # while ($index < scalar @problemList) { 1477 # if (defined $r->param("move.down.$index.x")) { 1478 # moveme($index, $db, $setID, @problemList); 1479 # } 1480 # $index++; 1481 # } 1482 # } 1483 1484 1485 # This erases any sticky fields if the user saves changes, resets the form, or reorders problems 1486 # It may not be obvious why this is necessary when saving changes or reordering problems 1487 # but when the problems are reorder the param problem.1.source_file needs to be the source 1488 # file of the problem that is NOW #1 and not the problem that WAS #1. 1489 unless (defined $r->param('refresh')) { 1490 1491 # reset all the parameters dealing with set/problem/header information 1492 # if the current naming scheme is changed/broken, this could reek havoc 1493 # on all kinds of things 1494 foreach my $param ($r->param) { 1495 $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; 1496 } 1497 } 1498 } 1499 1500 # helper method for debugging 1501 sub definedness ($) { 1502 my ($variable) = @_; 1503 1504 return "undefined" unless defined $variable; 1505 return "empty" unless $variable ne ""; 1506 return $variable; 1507 } 1508 1509 # helper method for checking if two things are different 1510 # the return values will usually be thrown away, but they could be useful for debugging 1511 sub changed ($$) { 1512 my ($first, $second) = @_; 1513 1514 return "def/undef" if defined $first and not defined $second; 1515 return "undef/def" if not defined $first and defined $second; 1516 return "" if not defined $first and not defined $second; 1517 return "ne" if $first ne $second; 1518 return ""; # if they're equal, there's no change 1519 } 1520 1521 # helper method that determines for how many users at a time a field can be changed 1522 # none means it can't be changed for anyone 1523 # any means it can be changed for anyone 1524 # one means it can ONLY be changed for one at a time. (eg problem_seed) 1525 # all means it can ONLY be changed for all at a time. (eg set_header) 1526 sub canChange ($$) { 1527 my ($forUsers, $field) = @_; 1528 1529 my %properties = %{ FIELD_PROPERTIES() }; 1530 my $forOneUser = $forUsers == 1; 1531 1532 my $howManyCan = $properties{$field}->{override}; 1533 return 0 if $howManyCan eq "none"; 1534 return 1 if $howManyCan eq "any"; 1535 return 1 if $howManyCan eq "one" && $forOneUser; 1536 return 1 if $howManyCan eq "all" && !$forUsers; 1537 return 0; # FIXME: maybe it should default to 1? 1538 } 1539 1540 # helper method that determines if a file is valid and returns a pretty error message 1541 sub checkFile ($) { 1542 my ($self, $filePath) = @_; 1543 1544 my $r = $self->r; 1545 my $ce = $r->ce; 1546 1547 return "No source filePath specified" unless $filePath; 1548 return "Problem source is drawn from a grouping set" if $filePath =~ /^group/; 1549 1550 1551 if ( $filePath eq "defaultHeader" ) { 1552 $filePath = $ce->{webworkFiles}{screenSnippets}{setHeader}; 1553 } else { 1554 # $filePath = $ce->{courseDirs}->{templates} . '/' . $filePath unless $filePath =~ m|^/|; # bug: 1725 allows access to all files e.g. /etc/passwd 1555 $filePath = $ce->{courseDirs}->{templates} . '/' . $filePath ; # only filePaths in template directory can be accessed 1556 } 1557 1558 my $text = "This source file "; 1559 my $fileError; 1560 return "" if -e $filePath && -f $filePath && -r $filePath; 1561 return $text . "is not readable!" if -e $filePath && -f $filePath; 1562 return $text . "is a directory!" if -d $filePath; 1563 return $text . "does not exist!" unless -e $filePath; 1564 return $text . "is not a plain file!"; 1565 } 1566 1567 # don't show view options -- we provide display mode controls for headers/problems separately 1568 sub options { 1569 return ""; 1570 } 1571 1572 # Creates two separate tables, first of the headers, and the of the problems in a given set 1573 # If one or more users are specified in the "editForUser" param, only the data for those users 1574 # becomes editable, not all the data 1575 sub body { 1576 1577 my ($self) = @_; 1578 my $r = $self->r; 1579 my $db = $r->db; 1580 my $ce = $r->ce; 1581 my $authz = $r->authz; 1582 my $userID = $r->param('user'); 1583 my $urlpath = $r->urlpath; 1584 my $courseID = $urlpath->arg("courseID"); 1585 my $setID = $urlpath->arg("setID"); 1586 1587 ## we're now allowing setID to come in as setID,v# to edit a set 1588 ## version; catch this first 1589 my $editingSetVersion = 0; 1590 my $fullSetID = $setID; 1591 if ( $setID =~ /,v(\d+)$/ ) { 1592 $editingSetVersion = $1; 1593 $setID =~ s/,v(\d+)$//; 1594 } 1595 1596 my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; 1597 1598 my $userRecord = $db->getUser($userID) or die "No record for user $userID."; 1599 # Check permissions 1600 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 1601 unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); 1602 1603 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") 1604 unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); 1605 1606 my @editForUser = $r->param('editForUser'); 1607 1608 return CGI::div({class=>"ResultsWithError"}, "Versions of a set can only be " . 1609 "edited for one user at a time.") if ( $editingSetVersion && @editForUser != 1 ); 1610 1611 # Check that every user that we're editing for has a valid UserSet 1612 my @assignedUsers; 1613 my @unassignedUsers; 1614 if (scalar @editForUser) { 1615 foreach my $ID (@editForUser) { 1616 # DBFIXME iterator 1617 if ($db->getUserSet($ID, $setID)) { 1618 unshift @assignedUsers, $ID; 1619 } else { 1620 unshift @unassignedUsers, $ID; 1621 } 1622 } 1623 @editForUser = sort @assignedUsers; 1624 $r->param("editForUser", \@editForUser); 1625 1626 if (scalar @editForUser && scalar @unassignedUsers) { 1627 print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); 1628 } elsif (scalar @editForUser == 0) { 1629 print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); 1630 print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); 1631 } 1632 } 1633 1634 # some useful booleans 1635 my $forUsers = scalar(@editForUser); 1636 my $forOneUser = $forUsers == 1; 1637 1638 # and check that if we're editing a set version for a user, that 1639 # it exists as well 1640 if ( $editingSetVersion && ! $db->existsSetVersion( $editForUser[0], $setID, $editingSetVersion ) ) { 1641 return CGI::div({class=>"ResultsWithError"}, "The set-version ($setID, version $editingSetVersion) is not assigned to user $editForUser[0]."); 1642 } 1643 1644 # If you're editing for users, initially their records will be different but 1645 # if you make any changes to them they will be the same. 1646 # if you're editing for one user, the problems shown should be his/hers 1647 my $userToShow = $forUsers ? $editForUser[0] : $userID; 1648 1649 # a useful gateway variable 1650 my $isGatewaySet = ( $setRecord->assignment_type =~ /gateway/ ) ? 1 : 0; 1651 1652 # DBFIXME no need to get ID lists -- counts would be fine 1653 my $userCount = $db->listUsers(); 1654 my $setCount = $db->listGlobalSets(); # if $forOneUser; 1655 my $setUserCount = $db->countSetUsers($setID); 1656 # if $forOneUser; 1657 my $userSetCount = ($forOneUser && @editForUser) ? $db->countUserSets($editForUser[0]) : 0; 1658 1659 1660 my $editUsersAssignedToSetURL = $self->systemLink( 1661 $urlpath->newFromModule( 1662 "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", 1663 courseID => $courseID, setID => $setID)); 1664 my $editSetsAssignedToUserURL = $self->systemLink( 1665 $urlpath->newFromModule( 1666 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1667 courseID => $courseID, userID => $editForUser[0])) if $forOneUser; 1668 1669 1670 my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); 1671 my $fullsetDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $fullSetID); 1672 my $setDetailURL = $self->systemLink($fullsetDetailPage, authen=>0); 1673 1674 my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); 1675 my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; 1676 1677 $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; 1678 $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; 1679 1680 if ($forUsers) { 1681 ############################################## 1682 # calculate links for the users being edited: 1683 ############################################## 1684 my @userLinks = (); 1685 foreach my $userID (@editForUser) { 1686 my $u = $db->getUser($userID); 1687 my $email_address = $u->email_address; 1688 my $line = $u->last_name.", " . $u->first_name . " (" . 1689 CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id . 1690 "). "; 1691 if ( ! $editingSetVersion ) { 1692 $line .= "Assigned to "; 1693 my $editSetsAssignedToUserURL = $self->systemLink( 1694 $urlpath->newFromModule( 1695 "WeBWorK::ContentGenerator::Instructor::UserDetail", 1696 courseID => $courseID, userID => $u->user_id)); 1697 $line .= CGI::a({href=>$editSetsAssignedToUserURL}, 1698 $self->setCountMessage($db->countUserSets($u->user_id), 1699 $setCount)); 1700 } else { 1701 my $editSetLink = $self->systemLink( $setDetailPage, 1702 params=>{effectiveUser=>$u->user_id, 1703 editForUser =>$u->user_id} ); 1704 $line .= "Edit set " . CGI::a({href=>$editSetLink},$setID) . 1705 " for this user."; 1706 } 1707 unshift @userLinks,$line; 1708 } 1709 @userLinks = sort @userLinks; 1710 1711 # handy messages when editing gateway sets 1712 my $gwmsg = ( $isGatewaySet && ! $editingSetVersion ) ? 1713 CGI::br() . CGI::em("To edit a specific student version of this set, " . 1714 "edit (all of) her/his assigned sets.") : ""; 1715 my $vermsg = ( $editingSetVersion ) ? ", test $editingSetVersion" : ""; 1716 1717 print CGI::table({border=>2,cellpadding=>10}, 1718 CGI::Tr({}, 1719 CGI::td([ 1720 "Editing problem set ".CGI::strong($setID . $vermsg)." data for these individual students:".CGI::br(). 1721 CGI::strong(join CGI::br(), @userLinks), 1722 CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set.") . $gwmsg, 1723 1724 ]) 1725 ) 1726 ); 1727 } else { 1728 print CGI::table({border=>2,cellpadding=>10}, 1729 CGI::Tr({}, 1730 CGI::td([ 1731 "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 1732 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", 1733 1734 ]) 1735 ) 1736 ); 1737 } 1738 1739 # handle renumbering of problems if necessary 1740 print CGI::a({name=>"problems"}); 1741 1742 my %newProblemNumbers = (); 1743 my $maxProblemNumber = -1; 1744 for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { 1745 $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); 1746 $maxProblemNumber = $jj if $jj > $maxProblemNumber; 1747 } 1748 1749 my $forceRenumber = $r->param('force_renumber') || 0; 1750 handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); 1751 1752 my %properties = %{ FIELD_PROPERTIES() }; 1753 1754 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 1755 my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; 1756 push @active_modes, 'None'; 1757 my $default_header_mode = $r->param('header.displaymode') || 'None'; 1758 my $default_problem_mode = $r->param('problem.displaymode') || 'None'; 1759 1760 ##################################################################### 1761 # Browse available header/problem files 1762 ##################################################################### 1763 1764 my $templates = $r->ce->{courseDirs}->{templates}; 1765 my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); 1766 1767 my @headerFileList = listFilesRecursive( 1768 $templates, 1769 qr/header.*\.pg$/i, # match these files 1770 qr/^(?:$skip|CVS)$/, # prune these directories 1771 0, # match against file name only 1772 1, # prune against path relative to $templates 1773 ); 1774 1775 1776 # Display a useful warning message 1777 if ($forUsers) { 1778 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . 1779 ($forOneUser ? "" : "s") . " listed above.")); 1780 } else { 1781 print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); 1782 } 1783 1784 print CGI::start_form({method=>"POST", action=>$setDetailURL}); 1785 print $self->hiddenEditForUserFields(@editForUser); 1786 print $self->hidden_authen_fields; 1787 print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); 1788 print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); 1789 1790 # spacing 1791 print CGI::p(); 1792 1793 ##################################################################### 1794 # Display general set information 1795 ##################################################################### 1796 1797 print CGI::start_table({border=>1, cellpadding=>4}); 1798 print CGI::Tr({}, CGI::th({}, [ 1799 "General Information", 1800 ])); 1801 1802 # this is kind of a hack -- we need to get a user record here, so we can 1803 # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so 1804 # FieldHTML doesn't have to fetch it itself. 1805 my $userSetRecord = $db->getUserSet($userToShow, $setID); 1806 1807 my $templateUserSetRecord; 1808 # send in the set version if we're editing for versions 1809 if ( $editingSetVersion ) { 1810 $templateUserSetRecord = $userSetRecord; 1811 $userSetRecord = $db->getSetVersion( $userToShow, $setID, $editingSetVersion ); 1812 } 1813 1814 print CGI::Tr({}, CGI::td({}, [ 1815 $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), 1816 ])); 1817 print CGI::end_table(); 1818 1819 # spacing 1820 print CGI::p(); 1821 1822 1823 ##################################################################### 1824 # Display header information 1825 ##################################################################### 1826 my @headers = @{ HEADER_ORDER() }; 1827 my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); 1828 my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); 1829 my @headerFiles = map { $setRecord->{$_} } @headers; 1830 if (scalar @headers and not $forUsers) { 1831 1832 print CGI::start_table({border=>1, cellpadding=>4}); 1833 print CGI::Tr({}, CGI::th({}, [ 1834 "Headers", 1835 # "Data", 1836 "Display Mode: " . 1837 CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. 1838 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1839 ])); 1840 1841 my %header_html; 1842 1843 my %error; 1844 my $this_set = $db->getMergedSet($userToShow, $setID); 1845 my $guaranteed_set = $this_set; 1846 if ( ! $guaranteed_set ) { 1847 # in the header loop we need to have a set that 1848 # we know exists, so if the getMergedSet failed 1849 # (that is, the set isn't assigned to the 1850 # the current user), we get the global set instead 1851 # $guaranteed_set = $db->getGlobalSet( $setID ); 1852 $guaranteed_set = $setRecord; 1853 } 1854 1855 foreach my $headerType (@headers) { 1856 1857 my $headerFile = $r->param("set.$setID.$headerType") || $setRecord->{$headerType} || $headerType; 1858 1859 $error{$headerType} = $self->checkFile($headerFile); 1860 1861 unless ($error{$headerType}) { 1862 my @temp = renderProblems( 1863 r=> $r, 1864 user => $db->getUser($userToShow), 1865 displayMode=> $default_header_mode, 1866 problem_number=> 0, 1867 this_set => $this_set, 1868 problem_list => [$headerFile], 1869 ); 1870 $header_html{$headerType} = $temp[0]; 1871 } 1872 } 1873 1874 foreach my $headerType (@headers) { 1875 1876 my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); 1877 my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $headerType, make_local_copy => 1 }); 1878 1879 my $viewHeaderPage = $urlpath->new(type => $headerModules{$headerType}, args => { courseID => $courseID, setID => $setID }); 1880 my $viewHeaderLink = $self->systemLink($viewHeaderPage); 1881 1882 # this is a bit of a hack; the set header isn't shown 1883 # for gateway tests, and we run into trouble trying to 1884 # edit/view it in this context, so we don't show this 1885 # field for gateway tests 1886 if ( $headerType eq 'set_header' && 1887 $guaranteed_set->assignment_type =~ /gateway/ ) { 1888 print CGI::Tr({}, CGI::td({}, 1889 [ "Set Header", 1890 "Set headers are not used in " . 1891 "display of gateway tests."])); 1892 next; 1893 } 1894 1895 1896 print CGI::Tr({}, CGI::td({}, [ 1897 CGI::start_table({border => 0, cellpadding => 0}) . 1898 CGI::Tr({}, CGI::td({}, $properties{$headerType}->{name})) . 1899 CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . 1900 CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . 1901 CGI::end_table(), 1902 1903 comboBox({ 1904 name => "set.$setID.$headerType", 1905 request => $r, 1906 default => $r->param("set.$setID.$headerType") || $setRecord->{$headerType}, 1907 multiple => 0, 1908 values => ["defaultHeader", @headerFileList], 1909 labels => { "defaultHeader" => "Use Default Header File" }, 1910 }) . 1911 ($error{$headerType} ? 1912 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$headerType}) 1913 : CGI::div({class=> "RenderSolo"}, $header_html{$headerType}->{body_text}) 1914 ), 1915 ])); 1916 } 1917 1918 print CGI::end_table(); 1919 } else { 1920 print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); 1921 } 1922 1923 # spacing 1924 print CGI::p(); 1925 1926 1927 ##################################################################### 1928 # Display problem information 1929 ##################################################################### 1930 1931 my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); 1932 1933 # DBFIXME use iterators instead of getting all at once 1934 1935 # get global problem records for all problems in one go 1936 my %GlobalProblems; 1937 my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; 1938 # DBFIXME shouldn't need to get key list here 1939 @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); 1940 1941 # if needed, get user problem records for all problems in one go 1942 my (%UserProblems, %MergedProblems); 1943 if ($forOneUser) { 1944 my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; 1945 # DBFIXME shouldn't need to get key list here 1946 @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); 1947 if ( ! $editingSetVersion ) { 1948 @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); 1949 } else { 1950 my @userversionKeypartsRef = map { [$editForUser[0], $setID, $editingSetVersion, $_] } @problemIDList; 1951 @MergedProblems{@problemIDList} = $db->getMergedProblemVersions(@userversionKeypartsRef); 1952 } 1953 } 1954 1955 if (scalar @problemIDList) { 1956 1957 print CGI::start_table({border=>1, cellpadding=>4}); 1958 print CGI::Tr({}, CGI::th({}, [ 1959 "Problems", 1960 "Data", 1961 "Display Mode: " . 1962 CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. 1963 CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), 1964 ])); 1965 1966 my %shownYet; 1967 my $repeatFile; 1968 1969 foreach my $problemID (@problemIDList) { 1970 1971 my $problemRecord; 1972 if ($forOneUser) { 1973 #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); 1974 $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam 1975 } else { 1976 #$problemRecord = $db->getGlobalProblem($setID, $problemID); 1977 $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam 1978 } 1979 1980 #$self->addgoodmessage(""); 1981 #$self->addbadmessage($problemRecord->toString()); 1982 1983 # when we're editing a set version, we want to be sure to 1984 # use the merged problem in the edit, because we could 1985 # be using problem groups (for which the problem is generated 1986 # and then stored in the problem version) 1987 my $problemToShow = ( $editingSetVersion ) ? 1988 $MergedProblems{$problemID} : $UserProblems{$problemID}; 1989 1990 my ( $editProblemPage, $editProblemLink, $viewProblemPage, 1991 $viewProblemLink ); 1992 if ( $isGatewaySet ) { 1993 $editProblemPage = $urlpath->new(type =>'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID }); 1994 $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 1995 $viewProblemPage = 1996 $urlpath->new(type =>'gateway_quiz', 1997 args => { courseID => $courseID, 1998 setID => "Undefined_Set", 1999 problemID => "1" } ); 2000 2001 my $seed = $problemToShow ? $problemToShow->problem_seed : ""; 2002 my $file = $problemToShow ? $problemToShow->source_file : 2003 $GlobalProblems{$problemID}->source_file; 2004 2005 $viewProblemLink = 2006 $self->systemLink( $viewProblemPage, 2007 params => { effectiveUser => 2008 ($forOneUser ? $editForUser[0] : $userID), 2009 problemSeed => $seed, 2010 sourceFilePath => $file }); 2011 } else { 2012 $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID }); 2013 $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); 2014 # FIXME: should we have an "act as" type link here when editing for multiple users? 2015 $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); 2016 $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); 2017 } 2018 2019 2020 my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; 2021 $problemFile =~ s|^/||; 2022 $problemFile =~ s|\.\.||g; 2023 # warn of repeat problems 2024 if (defined $shownYet{$problemFile}) { 2025 $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; 2026 } else { 2027 $shownYet{$problemFile} = $problemID; 2028 $repeatFile = ""; 2029 } 2030 2031 my $error = $self->checkFile($problemFile); 2032 my $this_set = $db->getMergedSet($userToShow, $setID); 2033 my @problem_html; 2034 unless ($error) { 2035 @problem_html = renderProblems( 2036 r=> $r, 2037 user => $db->getUser($userToShow), 2038 displayMode=> $default_problem_mode, 2039 problem_number=> $problemID, 2040 this_set => $this_set, 2041 problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, 2042 problem_list => [$problemFile], # [$problemRecord->source_file], 2043 ); 2044 } 2045 2046 # we want to show the "Try It" and "Edit It" links if there's a 2047 # well defined problem to view; this is when we're editing a 2048 # homework set, or if we're editing a gateway set version, or 2049 # if we're editing a gateway set and the problem is not a 2050 # group problem 2051 my $showLinks = ( ! $isGatewaySet || 2052 ( $editingSetVersion || $problemFile !~ /^group/ )); 2053 2054 2055 print CGI::Tr({}, CGI::td({}, [ 2056 CGI::start_table({border => 0, cellpadding => 1}) . 2057 CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . 2058 CGI::Tr({}, CGI::td({}, 2059 $showLinks ? CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it") : "" )) . 2060 CGI::Tr({}, CGI::td({}, 2061 $showLinks ? CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")) : "" )) . 2062 ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . 2063 # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . 2064 ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . 2065 CGI::end_table(), 2066 $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $problemToShow, $isGatewaySet), 2067 # A comprehensive list of problems is just TOO big to be handled well 2068 # comboBox({ 2069 # name => "set.$setID.$problemID", 2070 # request => $r, 2071 # default => $problemRecord->{problem_id}, 2072 # multiple => 0, 2073 # values => \@problemFileList, 2074 # }) . 2075 2076 join ("\n", $self->FieldHTML( 2077 $userToShow, 2078 $setID, 2079 $problemID, 2080 $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam 2081 $problemToShow, # pass previously fetched user record to FieldHTML --sam 2082 "source_file" 2083 )) . 2084 CGI::br() . 2085 ($error ? 2086 CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) 2087 : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) 2088 ) . 2089 ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), 2090 ])); 2091 } 2092 2093 2094 # print final lines 2095 print CGI::end_table(); 2096 print CGI::checkbox({ 2097 label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", 2098 name=>"force_renumber", value=>"1"}); 2099 print CGI::p(<<EOF); 2100 Any time problem numbers are intentionally changed, the problems will 2101 always be renumbered consecutively, starting from one. When deleting 2102 problems, gaps will be left in the numbering unless the box above is 2103 checked. 2104 EOF 2105 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()); 2106 print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); 2107 2108 } else { 2109 print CGI::p(CGI::b("This set doesn't contain any problems yet.")); 2110 } 2111 # always allow one to add a new problem, unless we're editing a set version 2112 if ( ! $editingSetVersion ) { 2113 print CGI::checkbox({ label=> "Add", 2114 name=>"add_blank_problem", value=>"1"} 2115 ),CGI::input({ 2116 name=>"add_n_problems", 2117 size=>2, 2118 value=>1 }, 2119 "blank problem template(s) to end of homework set" 2120 ); 2121 } 2122 print CGI::br(),CGI::br(), 2123 CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), 2124 CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), 2125 "(Any unsaved changes will be lost.)"; 2126 2127 #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); 2128 #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); 2129 # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME 2130 #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); 2131 2132 print CGI::end_form(); 2133 2134 return ""; 2135 } 2136 2137 1; 2138 2139 =head1 AUTHOR 2140 2141 Written by Robert Van Dam, toenail (at) cif.rochester.edu 2142 2143 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |