Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-1-patches'.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: 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::ProblemSetList; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::ProblemSetList - Entry point for Set-specific 23 data editing/viewing 24 25 =cut 26 27 =for comment 28 29 What do we want to be able to do here? 30 31 filter sort edit publish import create delete 32 33 Filter what sets are shown: 34 - none, all, selected 35 - matching set_id, visible to students, hidden from students 36 37 Sort sets by: 38 - set name 39 - open date 40 - due date 41 - answer date 42 - header files 43 - visibility to students 44 45 Switch from view mode to edit mode: 46 - showing visible sets 47 - showing selected sets 48 Switch from edit mode to view and save changes 49 Switch from edit mode to view and abandon changes 50 51 Make sets visible to or hidden from students: 52 - all, selected 53 54 Import sets: 55 - replace: 56 - any users 57 - visible users 58 - selected users 59 - no users 60 - add: 61 - any users 62 - no users 63 64 Score sets: 65 - all 66 - visible 67 - selected 68 69 Create a set with a given name 70 71 Delete sets: 72 - visible 73 - selected 74 75 =cut 76 77 # FIXME: rather than having two types of boolean modes $editMode and $exportMode 78 # make one $mode variable that contains a string like "edit", "view", or "export" 79 80 use strict; 81 use warnings; 82 use CGI qw(); 83 use WeBWorK::Utils qw(readFile listFilesRecursive cryptPassword sortByName); 84 85 use constant HIDE_SETS_THRESHOLD => 50; 86 use constant DEFAULT_PUBLISHED_STATE => 1; 87 88 use constant EDIT_FORMS => [qw(cancelEdit saveEdit)]; 89 use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)]; 90 use constant EXPORT_FORMS => [qw(cancelExport saveExport)]; 91 92 use constant VIEW_FIELD_ORDER => [ qw( select set_id problems users published open_date due_date answer_date) ]; 93 use constant EDIT_FIELD_ORDER => [ qw( set_id published open_date due_date answer_date) ]; 94 use constant EXPORT_FIELD_ORDER => [ qw( select set_id filename) ]; 95 96 # permissions needed to perform a given action 97 use constant FORM_PERMS => { 98 saveEdit => "modify_problem_sets", 99 edit => "modify_problem_sets", 100 publish => "modify_problem_sets", 101 import => "create_and_delete_problem_sets", 102 export => "modify_set_def_files", 103 saveExport => "modify_set_def_files", 104 score => "score_sets", 105 create => "create_and_delete_problem_sets", 106 delete => "create_and_delete_problem_sets", 107 }; 108 109 # permissions needed to view a given field 110 use constant FIELD_PERMS => { 111 problems => "modify_problem_sets", 112 users => "assign_problem_sets", 113 }; 114 115 use constant STATE_PARAMS => [qw(user effectiveUser key visible_sets no_visible_sets prev_visible_sets no_prev_visible_set editMode exportMode primarySortField secondarySortField)]; 116 117 use constant SORT_SUBS => { 118 set_id => \&bySetID, 119 set_header => \&bySetHeader, 120 hardcopy_header => \&byHardcopyHeader, 121 open_date => \&byOpenDate, 122 due_date => \&byDueDate, 123 answer_date => \&byAnswerDate, 124 published => \&byPublished, 125 126 }; 127 128 use constant FIELD_PROPERTIES => { 129 set_id => { 130 type => "text", 131 size => 8, 132 access => "readonly", 133 }, 134 set_header => { 135 type => "filelist", 136 size => 10, 137 access => "readonly", 138 }, 139 hardcopy_header => { 140 type => "filelist", 141 size => 10, 142 access => "readonly", 143 }, 144 open_date => { 145 type => "text", 146 size => 24, 147 access => "readwrite", 148 }, 149 due_date => { 150 type => "text", 151 size => 24, 152 access => "readwrite", 153 }, 154 answer_date => { 155 type => "text", 156 size => 24, 157 access => "readwrite", 158 }, 159 published => { 160 type => "checked", 161 size => 4, 162 access => "readwrite", 163 }, 164 }; 165 166 sub pre_header_initialize { 167 my ($self) = @_; 168 my $r = $self->r; 169 my $db = $r->db; 170 my $ce = $r->ce; 171 my $authz = $r->authz; 172 my $urlpath = $r->urlpath; 173 my $user = $r->param('user'); 174 my $courseName = $urlpath->arg("courseID"); 175 176 177 # Check permissions 178 return unless $authz->hasPermissions($user, "access_instructor_tools"); 179 180 if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) { 181 my $scope = $r->param("action.score.scope"); 182 my @setsToScore = (); 183 184 if ($scope eq "none") { 185 return "No sets selected for scoring."; 186 } elsif ($scope eq "all") { 187 @setsToScore = @{ $r->param("allSetIDs") }; 188 } elsif ($scope eq "visible") { 189 @setsToScore = @{ $r->param("visibleSetIDs") }; 190 } elsif ($scope eq "selected") { 191 @setsToScore = $r->param("selected_sets"); 192 } 193 194 my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', courseID=>$courseName), 195 params=>{ 196 scoreSelected=>"ScoreSelected", 197 selectedSet=>\@setsToScore, 198 # recordSingleSetScores=>'' 199 } 200 ); 201 202 $self->reply_with_redirect($uri); 203 } 204 205 } 206 207 sub body { 208 my ($self) = @_; 209 my $r = $self->r; 210 my $urlpath = $r->urlpath; 211 my $db = $r->db; 212 my $ce = $r->ce; 213 my $authz = $r->authz; 214 my $courseName = $urlpath->arg("courseID"); 215 my $setID = $urlpath->arg("setID"); 216 my $user = $r->param('user'); 217 218 my $root = $ce->{webworkURLs}->{root}; 219 220 # templates for getting field names 221 my $setTemplate = $self->{setTemplate} = $db->newGlobalSet; 222 223 return CGI::div({class => "ResultsWithError"}, "You are not authorized to access the Instructor tools.") 224 unless $authz->hasPermissions($user, "access_instructor_tools"); 225 226 # This table can be consulted when display-ready forms of field names are needed. 227 my %prettyFieldNames = map { $_ => $_ } 228 $setTemplate->FIELDS(); 229 230 @prettyFieldNames{qw( 231 select 232 problems 233 users 234 filename 235 set_id 236 set_header 237 hardcopy_header 238 open_date 239 due_date 240 answer_date 241 published 242 )} = ( 243 "Select", 244 "Edit<br> Problems", 245 "Edit<br> Assigned Users", 246 "Set Definition Filename", 247 "Edit<br> Set Data", 248 "Set Header", 249 "Hardcopy Header", 250 "Open Date", 251 "Due Date", 252 "Answer Date", 253 "Visible", 254 ); 255 256 ########## set initial values for state fields 257 258 my @allSetIDs = $db->listGlobalSets; 259 my @users = $db->listUsers; 260 $self->{allSetIDs} = \@allSetIDs; 261 $self->{totalUsers} = scalar @users; 262 263 if (defined $r->param("visible_sets")) { 264 $self->{visibleSetIDs} = [ $r->param("visible_sets") ]; 265 } elsif (defined $r->param("no_visible_sets")) { 266 $self->{visibleSetIDs} = []; 267 } else { 268 if (@allSetIDs > HIDE_SETS_THRESHOLD) { 269 $self->{visibleSetIDs} = []; 270 } else { 271 $self->{visibleSetIDs} = [ @allSetIDs ]; 272 } 273 } 274 275 $self->{prevVisibleSetIDs} = $self->{visibleSetIDs}; 276 277 if (defined $r->param("selected_sets")) { 278 $self->{selectedSetIDs} = [ $r->param("selected_sets") ]; 279 } else { 280 $self->{selectedSetIDs} = []; 281 } 282 283 $self->{editMode} = $r->param("editMode") || 0; 284 285 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify problem sets.")) 286 if $self->{editMode} and not $authz->hasPermissions($user, "modify_problem_sets"); 287 288 $self->{exportMode} = $r->param("exportMode") || 0; 289 290 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify set definition files.")) 291 if $self->{exportMode} and not $authz->hasPermissions($user, "modify_set_def_files"); 292 293 $self->{primarySortField} = $r->param("primarySortField") || "due_date"; 294 $self->{secondarySortField} = $r->param("secondarySortField") || "open_date"; 295 296 my @allSets = $db->getGlobalSets(@allSetIDs); 297 298 my (%open_dates, %due_dates, %answer_dates); 299 foreach my $Set (@allSets) { 300 push @{$open_dates{defined $Set->open_date ? $Set->open_date : ""}}, $Set->set_id; 301 push @{$due_dates{defined $Set->due_date ? $Set->due_date : ""}}, $Set->set_id; 302 push @{$answer_dates{defined $Set->answer_date ? $Set->answer_date : ""}}, $Set->set_id; 303 } 304 $self->{open_dates} = \%open_dates; 305 $self->{due_dates} = \%due_dates; 306 $self->{answer_dates} = \%answer_dates; 307 308 ########## call action handler 309 310 my $actionID = $r->param("action"); 311 if ($actionID) { 312 unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) { 313 die "Action $actionID not found"; 314 } 315 # Check permissions 316 if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { 317 my $actionHandler = "${actionID}_handler"; 318 my %genericParams; 319 foreach my $param (qw(selected_sets)) { 320 $genericParams{$param} = [ $r->param($param) ]; 321 } 322 my %actionParams = $self->getActionParams($actionID); 323 my %tableParams = $self->getTableParams(); 324 print CGI::div({class=>"Message"}, CGI::p("Results of last action performed: ", $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams))), CGI::hr(); 325 } else { 326 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to perform this action.")); 327 } 328 329 } 330 331 ########## retrieve possibly changed values for member fields 332 333 @allSetIDs = @{ $self->{allSetIDs} }; # do we need this one? YES, deleting or importing a set will change this. 334 my @visibleSetIDs = @{ $self->{visibleSetIDs} }; 335 my @prevVisibleSetIDs = @{ $self->{prevVisibleSetIDs} }; 336 my @selectedSetIDs = @{ $self->{selectedSetIDs} }; 337 my $editMode = $self->{editMode}; 338 my $exportMode = $self->{exportMode}; 339 my $primarySortField = $self->{primarySortField}; 340 my $secondarySortField = $self->{secondarySortField}; 341 342 #warn "visibleSetIDs=@visibleSetIDs\n"; 343 #warn "prevVisibleSetIDs=@prevVisibleSetIDs\n"; 344 #warn "selectedSetIDs=@selectedSetIDs\n"; 345 #warn "editMode=$editMode\n"; 346 347 ########## get required users 348 349 my @Sets = grep { defined $_ } @visibleSetIDs ? $db->getGlobalSets(@visibleSetIDs) : (); 350 351 # presort users 352 my %sortSubs = %{ SORT_SUBS() }; 353 my $primarySortSub = $sortSubs{$primarySortField}; 354 my $secondarySortSub = $sortSubs{$secondarySortField}; 355 356 # don't forget to sort in opposite order of importance 357 if ($secondarySortField eq "set_id") { 358 @Sets = sortByName("set_id", @Sets); 359 } else { 360 @Sets = sort $secondarySortSub @Sets; 361 } 362 363 if ($primarySortField eq "set_id") { 364 @Sets = sortByName("set_id", @Sets); 365 } else { 366 @Sets = sort $primarySortSub @Sets; 367 } 368 369 ########## print beginning of form 370 371 print CGI::start_form({method=>"post", action=>$self->systemLink($urlpath,authen=>0), name=>"problemsetlist"}); 372 print $self->hidden_authen_fields(); 373 374 ########## print state data 375 376 print "\n<!-- state data here -->\n"; 377 378 if (@visibleSetIDs) { 379 print CGI::hidden(-name=>"visible_sets", -value=>\@visibleSetIDs); 380 } else { 381 print CGI::hidden(-name=>"no_visible_sets", -value=>"1"); 382 } 383 384 if (@prevVisibleSetIDs) { 385 print CGI::hidden(-name=>"prev_visible_sets", -value=>\@prevVisibleSetIDs); 386 } else { 387 print CGI::hidden(-name=>"no_prev_visible_sets", -value=>"1"); 388 } 389 390 print CGI::hidden(-name=>"editMode", -value=>$editMode); 391 print CGI::hidden(-name=>"exportMode", -value=>$exportMode); 392 393 print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField); 394 print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField); 395 396 print "\n<!-- state data here -->\n"; 397 398 ########## print action forms 399 400 print CGI::start_table({}); 401 print CGI::Tr({}, CGI::td({-colspan=>2}, "Select an action to perform:")); 402 403 my @formsToShow; 404 if ($editMode) { 405 @formsToShow = @{ EDIT_FORMS() }; 406 } else { 407 @formsToShow = @{ VIEW_FORMS() }; 408 } 409 410 if ($exportMode) { 411 @formsToShow = @{ EXPORT_FORMS() }; 412 } 413 414 my $i = 0; 415 foreach my $actionID (@formsToShow) { 416 # Check permissions 417 next if FORM_PERMS()->{$actionID} and not $authz->hasPermissions($user, FORM_PERMS()->{$actionID}); 418 my $actionForm = "${actionID}_form"; 419 my $onChange = "document.problemsetlist.action[$i].checked=true"; 420 my %actionParams = $self->getActionParams($actionID); 421 422 print CGI::Tr({-valign=>"top"}, 423 CGI::td({}, CGI::input({-type=>"radio", -name=>"action", -value=>$actionID})), 424 CGI::td({}, $self->$actionForm($onChange, %actionParams)) 425 ); 426 427 $i++; 428 } 429 430 print CGI::Tr({}, CGI::td({-colspan=>2, -align=>"center"}, 431 CGI::submit(-value=>"Take Action!")) 432 ); 433 print CGI::end_table(); 434 435 ########## print table 436 437 ########## first adjust heading if in editMode 438 $prettyFieldNames{set_id} = "Edit All <br> Set Data" if $editMode; 439 440 441 print CGI::p("Showing ", scalar @visibleSetIDs, " out of ", scalar @allSetIDs, " sets."); 442 443 $self->printTableHTML(\@Sets, \%prettyFieldNames, 444 editMode => $editMode, 445 exportMode => $exportMode, 446 selectedSetIDs => \@selectedSetIDs, 447 ); 448 449 450 ########## print end of form 451 452 print CGI::end_form(); 453 454 return ""; 455 } 456 457 ################################################################################ 458 # extract particular params and put them in a hash (values are ARRAYREFs!) 459 ################################################################################ 460 461 sub getActionParams { 462 my ($self, $actionID) = @_; 463 my $r = $self->{r}; 464 465 my %actionParams; 466 foreach my $param ($r->param) { 467 next unless $param =~ m/^action\.$actionID\./; 468 $actionParams{$param} = [ $r->param($param) ]; 469 } 470 return %actionParams; 471 } 472 473 sub getTableParams { 474 my ($self) = @_; 475 my $r = $self->{r}; 476 477 my %tableParams; 478 foreach my $param ($r->param) { 479 next unless $param =~ m/^(?:set)\./; 480 $tableParams{$param} = [ $r->param($param) ]; 481 } 482 return %tableParams; 483 } 484 485 ################################################################################ 486 # actions and action triggers 487 ################################################################################ 488 489 # filter, edit, cancelEdit, and saveEdit should stay with the display module and 490 # not be real "actions". that way, all actions are shown in view mode and no 491 # actions are shown in edit mode. 492 493 sub filter_form { 494 my ($self, $onChange, %actionParams) = @_; 495 #return CGI::table({}, CGI::Tr({-valign=>"top"}, 496 # CGI::td({}, 497 return join("", 498 "Show ", 499 CGI::popup_menu( 500 -name => "action.filter.scope", 501 -values => [qw(all none selected match_ids published unpublished)], 502 -default => $actionParams{"action.filter.scope"}->[0] || "match_ids", 503 -labels => { 504 all => "all sets", 505 none => "no sets", 506 selected => "sets checked below", 507 published => "sets visible to students", 508 unpublished => "sets hidden from students", 509 match_ids => "sets with matching set IDs:", 510 }, 511 -onchange => $onChange, 512 ), 513 " ", 514 CGI::textfield( 515 -name => "action.filter.set_ids", 516 -value => $actionParams{"action.filter.set_ids"}->[0] || "",, 517 -width => "50", 518 -onchange => $onChange, 519 ), 520 " (separate multiple IDs with commas)", 521 CGI::br(), 522 # "Open dates: ", 523 # CGI::popup_menu( 524 # -name => "action.filter.open_date", 525 # -values => [ keys %{ $self->{open_dates} } ], 526 # -default => $actionParams{"action.filter.open_date"}->[0] || "", 527 # -labels => { $self->menuLabels($self->{open_dates}) }, 528 # -onchange => $onChange, 529 # ), 530 # " Due dates: ", 531 # CGI::popup_menu( 532 # -name => "action.filter.due_date", 533 # -values => [ keys %{ $self->{due_dates} } ], 534 # -default => $actionParams{"action.filter.due_date"}->[0] || "", 535 # -labels => { $self->menuLabels($self->{due_dates}) }, 536 # -onchange => $onChange, 537 # ), 538 # " Answer dates: ", 539 # CGI::popup_menu( 540 # -name => "action.filter.answer_date", 541 # -values => [ keys %{ $self->{answer_dates} } ], 542 # -default => $actionParams{"action.filter.answer_date"}->[0] || "", 543 # -labels => { $self->menuLabels($self->{answer_dates}) }, 544 # -onchange => $onChange, 545 # ), 546 547 ); 548 } 549 550 # this action handler modifies the "visibleUserIDs" field based on the contents 551 # of the "action.filter.scope" parameter and the "selected_users" 552 sub filter_handler { 553 my ($self, $genericParams, $actionParams, $tableParams) = @_; 554 555 my $r = $self->r ; 556 my $db = $r->db; 557 558 my $result; 559 560 my $scope = $actionParams->{"action.filter.scope"}->[0]; 561 if ($scope eq "all") { 562 $result = "showing all sets"; 563 $self->{visibleSetIDs} = $self->{allSetIDs}; 564 } elsif ($scope eq "none") { 565 $result = "showing no sets"; 566 $self->{visibleSetIDs} = []; 567 } elsif ($scope eq "selected") { 568 $result = "showing selected sets"; 569 $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref 570 } elsif ($scope eq "match_ids") { 571 my @setIDs = split /\s*,\s*/, $actionParams->{"action.filter.set_ids"}->[0]; 572 $self->{visibleSetIDs} = \@setIDs; 573 } elsif ($scope eq "match_open_date") { 574 my $open_date = $actionParams->{"action.filter.open_date"}->[0]; 575 $self->{visibleSetIDs} = $self->{open_dates}->{$open_date}; # an arrayref 576 } elsif ($scope eq "match_due_date") { 577 my $due_date = $actionParams->{"action.filter.due_date"}->[0]; 578 $self->{visibleSetIDs} = $self->{due_date}->{$due_date}; # an arrayref 579 } elsif ($scope eq "match_answer_date") { 580 my $answer_date = $actionParams->{"action.filter.answer_date"}->[0]; 581 $self->{visibleSetIDs} = $self->{answer_dates}->{$answer_date}; # an arrayref 582 } elsif ($scope eq "published") { 583 my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}}); 584 my @publishedSetIDs = map { $_->published ? $_->set_id : ""} @setRecords; 585 $self->{visibleSetIDs} = \@publishedSetIDs; 586 } elsif ($scope eq "unpublished") { 587 my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}}); 588 my @unpublishedSetIDs = map { (not $_->published) ? $_->set_id : ""} @setRecords; 589 $self->{visibleSetIDs} = \@unpublishedSetIDs; 590 } 591 592 return $result; 593 } 594 595 sub sort_form { 596 my ($self, $onChange, %actionParams) = @_; 597 return join ("", 598 "Primary sort: ", 599 CGI::popup_menu( 600 -name => "action.sort.primary", 601 -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date published)], 602 -default => $actionParams{"action.sort.primary"}->[0] || "due_date", 603 -labels => { 604 set_id => "Set Name", 605 set_header => "Set Header", 606 hardcopy_header => "Hardcopy Header", 607 open_date => "Open Date", 608 due_date => "Due Date", 609 answer_date => "Answer Date", 610 published => "Visibility", 611 }, 612 -onchange => $onChange, 613 ), 614 " Secondary sort: ", 615 CGI::popup_menu( 616 -name => "action.sort.secondary", 617 -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date published)], 618 -default => $actionParams{"action.sort.secondary"}->[0] || "open_date", 619 -labels => { 620 set_id => "Set Name", 621 set_header => "Set Header", 622 hardcopy_header => "Hardcopy Header", 623 open_date => "Open Date", 624 due_date => "Due Date", 625 answer_date => "Answer Date", 626 published => "Visibility", 627 }, 628 -onchange => $onChange, 629 ), 630 ".", 631 ); 632 } 633 634 sub sort_handler { 635 my ($self, $genericParams, $actionParams, $tableParams) = @_; 636 637 my $primary = $actionParams->{"action.sort.primary"}->[0]; 638 my $secondary = $actionParams->{"action.sort.secondary"}->[0]; 639 640 $self->{primarySortField} = $primary; 641 $self->{secondarySortField} = $secondary; 642 643 my %names = ( 644 set_id => "Set Name", 645 set_header => "Set Header", 646 hardcopy_header => "Hardcopy Header", 647 open_date => "Open Date", 648 due_date => "Due Date", 649 answer_date => "Answer Date", 650 published => "Visibility", 651 ); 652 653 return "sort by $names{$primary} and then by $names{$secondary}."; 654 } 655 656 657 sub edit_form { 658 my ($self, $onChange, %actionParams) = @_; 659 660 return join("", 661 "Edit ", 662 CGI::popup_menu( 663 -name => "action.edit.scope", 664 -values => [qw(all visible selected)], 665 -default => $actionParams{"action.edit.scope"}->[0] || "selected", 666 -labels => { 667 all => "all sets", 668 visible => "visible sets", 669 selected => "selected sets", 670 }, 671 -onchange => $onChange, 672 ), 673 ); 674 } 675 676 sub edit_handler { 677 my ($self, $genericParams, $actionParams, $tableParams) = @_; 678 679 my $result; 680 681 my $scope = $actionParams->{"action.edit.scope"}->[0]; 682 if ($scope eq "all") { 683 $result = "editing all sets"; 684 $self->{visibleSetIDs} = $self->{allSetIDs}; 685 } elsif ($scope eq "visible") { 686 $result = "editing visible sets"; 687 # leave visibleUserIDs alone 688 } elsif ($scope eq "selected") { 689 $result = "editing selected sets"; 690 $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref 691 } 692 $self->{editMode} = 1; 693 694 return $result; 695 } 696 697 sub publish_form { 698 my ($self, $onChange, %actionParams) = @_; 699 700 return join ("", 701 "Make ", 702 CGI::popup_menu( 703 -name => "action.publish.scope", 704 -values => [ qw(none all selected) ], 705 -default => $actionParams{"action.publish.scope"}->[0] || "selected", 706 -labels => { 707 none => "", 708 all => "all sets", 709 # visible => "visible sets", 710 selected => "selected sets", 711 }, 712 -onchange => $onChange, 713 ), 714 CGI::popup_menu( 715 -name => "action.publish.value", 716 -values => [ 0, 1 ], 717 -default => $actionParams{"action.publish.value"}->[0] || "1", 718 -labels => { 719 0 => "hidden", 720 1 => "visible", 721 }, 722 -onchange => $onChange, 723 ), 724 " for students.", 725 ); 726 } 727 728 sub publish_handler { 729 my ($self, $genericParams, $actionParams, $tableParams) = @_; 730 731 my $r = $self->r; 732 my $db = $r->db; 733 734 my $result = ""; 735 736 my $scope = $actionParams->{"action.publish.scope"}->[0]; 737 my $value = $actionParams->{"action.publish.value"}->[0]; 738 739 my $verb = $value ? "made visible for" : "hidden from"; 740 741 my @setIDs; 742 743 if ($scope eq "none") { # FIXME: double negative "Make no sets hidden" might make professor expect all sets to be made visible. 744 @setIDs = (); 745 $result = "No change made to any set."; 746 } elsif ($scope eq "all") { 747 @setIDs = @{ $self->{allSetIDs} }; 748 $result = "All sets $verb all students."; 749 } elsif ($scope eq "visible") { 750 @setIDs = @{ $self->{visibleSetIDs} }; 751 $result = "All visible sets $verb all students."; 752 } elsif ($scope eq "selected") { 753 @setIDs = @{ $genericParams->{selected_sets} }; 754 $result = "All selected sets $verb all students."; 755 } 756 757 my @sets = $db->getGlobalSets(@setIDs); 758 759 map { $_->published("$value") if $_; $db->putGlobalSet($_); } @sets; 760 761 return $result 762 763 } 764 765 sub score_form { 766 my ($self, $onChange, %actionParams) = @_; 767 768 return join ("", 769 "Score ", 770 CGI::popup_menu( 771 -name => "action.score.scope", 772 -values => [qw(none all selected)], 773 -default => $actionParams{"action.score.scope"}->[0] || "none", 774 -labels => { 775 none => "no sets.", 776 all => "all sets.", 777 selected => "selected sets.", 778 }, 779 -onchange => $onChange, 780 ), 781 ); 782 783 784 785 } 786 787 sub score_handler { 788 my ($self, $genericParams, $actionParams, $tableParams) = @_; 789 790 my $r = $self->r; 791 my $urlpath = $r->urlpath; 792 my $courseName = $urlpath->arg("courseID"); 793 794 my $scope = $actionParams->{"action.score.scope"}->[0]; 795 my @setsToScore; 796 797 if ($scope eq "none") { 798 @setsToScore = (); 799 return "No sets selected for scoring."; 800 } elsif ($scope eq "all") { 801 @setsToScore = @{ $self->{allSetIDs} }; 802 } elsif ($scope eq "visible") { 803 @setsToScore = @{ $self->{visibleSetIDs} }; 804 } elsif ($scope eq "selected") { 805 @setsToScore = @{ $genericParams->{selected_sets} }; 806 } 807 808 my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', courseID=>$courseName), 809 params=>{ 810 scoreSelected=>"Score Selected", 811 selectedSet=>\@setsToScore, 812 # recordSingleSetScores=>'' 813 } 814 ); 815 816 817 return $uri; 818 } 819 820 821 sub delete_form { 822 my ($self, $onChange, %actionParams) = @_; 823 824 return join("", 825 CGI::div({class=>"ResultsWithError"}, 826 "Delete ", 827 CGI::popup_menu( 828 -name => "action.delete.scope", 829 -values => [qw(none selected)], 830 -default => $actionParams{"action.delete.scope"}->[0] || "none", 831 -labels => { 832 none => "no sets.", 833 #visble => "visible sets.", 834 selected => "selected sets.", 835 }, 836 -onchange => $onChange, 837 ), 838 CGI::em(" Deletion destroys all set-related data and is not undoable!"), 839 ) 840 ); 841 } 842 843 sub delete_handler { 844 my ($self, $genericParams, $actionParams, $tableParams) = @_; 845 846 my $r = $self->r; 847 my $db = $r->db; 848 849 my $scope = $actionParams->{"action.delete.scope"}->[0]; 850 851 852 my @setIDsToDelete = (); 853 854 if ($scope eq "selected") { 855 @setIDsToDelete = @{ $self->{selectedSetIDs} }; 856 } 857 858 my %allSetIDs = map { $_ => 1 } @{ $self->{allSetIDs} }; 859 my %visibleSetIDs = map { $_ => 1 } @{ $self->{visibleSetIDs} }; 860 my %selectedSetIDs = map { $_ => 1 } @{ $self->{selectedSetIDs} }; 861 862 foreach my $setID (@setIDsToDelete) { 863 delete $allSetIDs{$setID}; 864 delete $visibleSetIDs{$setID}; 865 delete $selectedSetIDs{$setID}; 866 $db->deleteGlobalSet($setID); 867 } 868 869 $self->{allSetIDs} = [ keys %allSetIDs ]; 870 $self->{visibleSetIDs} = [ keys %visibleSetIDs ]; 871 $self->{selectedSetIDs} = [ keys %selectedSetIDs ]; 872 873 my $num = @setIDsToDelete; 874 return "deleted $num set" . ($num == 1 ? "" : "s"); 875 } 876 877 sub create_form { 878 my ($self, $onChange, %actionParams) = @_; 879 880 my $r = $self->r; 881 882 return "Create a new set named: ", 883 CGI::textfield( 884 -name => "action.create.name", 885 -value => $actionParams{"action.create.name"}->[0] || "", 886 -width => "50", 887 -onchange => $onChange, 888 ), 889 " as ", 890 CGI::popup_menu( 891 -name => "action.create.type", 892 -values => [qw(empty copy)], 893 -default => $actionParams{"action.create.type"}->[0] || "empty", 894 -labels => { 895 empty => "a new empty set.", 896 copy => "a duplicate of the first selected set.", 897 }, 898 -onchange => $onChange, 899 ); 900 901 } 902 903 sub create_handler { 904 my ($self, $genericParams, $actionParams, $tableParams) = @_; 905 906 my $r = $self->r; 907 my $db = $r->db; 908 909 my $newSetRecord = $db->newGlobalSet; 910 my $oldSetID = $self->{selectedSetIDs}->[0]; 911 my $newSetID = $actionParams->{"action.create.name"}->[0]; 912 return CGI::div({class => "ResultsWithError"}, "Failed to create new set: no set name specified!") unless $newSetID =~ /\S/; 913 914 my $type = $actionParams->{"action.create.type"}->[0]; 915 if ($type eq "empty") { 916 $newSetRecord->set_id($newSetID); 917 $newSetRecord->set_header(""); 918 $newSetRecord->hardcopy_header(""); 919 $newSetRecord->open_date("0"); 920 $newSetRecord->due_date("0"); 921 $newSetRecord->answer_date("0"); 922 $newSetRecord->published(DEFAULT_PUBLISHED_STATE); # don't want students to see an empty set 923 $db->addGlobalSet($newSetRecord); 924 } elsif ($type eq "copy") { 925 return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set selected for duplication!") unless $oldSetID =~ /\S/; 926 $newSetRecord = $db->getGlobalSet($oldSetID); 927 $newSetRecord->set_id($newSetID); 928 $db->addGlobalSet($newSetRecord); 929 930 # take all the problems from the old set and make them part of the new set 931 foreach ($db->getAllGlobalProblems($oldSetID)) { 932 $_->set_id($newSetID); 933 $db->addGlobalProblem($_); 934 } 935 } 936 937 push @{ $self->{visibleSetIDs} }, $newSetID; 938 push @{ $self->{allSetIds} }, $newSetID; 939 940 return CGI::div({class => "ResultsWithError"}, "Failed to create new set: $@") if $@; 941 942 return "Successfully created new set $newSetID"; 943 944 } 945 946 sub import_form { 947 my ($self, $onChange, %actionParams) = @_; 948 949 my $r = $self->r; 950 my $authz = $r->authz; 951 my $user = $r->param('user'); 952 953 # this will make the popup menu alternate between a single selection and a multiple selection menu 954 # Note: search by name is required since document.problemsetlist.action.import.number is not seen as 955 # a valid reference to the object named 'action.import.number' 956 my $importScript = join (" ", 957 "var number = document.getElementsByName('action.import.number')[0].value;", 958 "document.getElementsByName('action.import.source')[0].size = number;", 959 "document.getElementsByName('action.import.source')[0].multiple = (number > 1 ? true : false);", 960 "document.getElementsByName('action.import.name')[0].value = (number > 1 ? '(taken from filenames)' : '');", 961 ); 962 963 return join(" ", 964 "Import ", 965 CGI::popup_menu( 966 -name => "action.import.number", 967 -values => [ 1, 8 ], 968 -default => $actionParams{"action.import.number"}->[0] || "1", 969 -labels => { 970 1 => "a single set", 971 8 => "multiple sets", 972 }, 973 -onchange => "$onChange;$importScript", 974 ), 975 " from ", # set definition file(s) ", 976 CGI::popup_menu( 977 -name => "action.import.source", 978 -values => [ "", $self->getDefList() ], 979 -labels => { "" => "the following file(s)" }, 980 -default => $actionParams{"action.import.source"}->[0] || "", 981 -size => $actionParams{"action.import.number"}->[0] || "1", 982 -onchange => $onChange, 983 ), 984 " with set name(s): ", 985 CGI::textfield( 986 -name => "action.import.name", 987 -value => $actionParams{"action.import.name"}->[0] || "", 988 -width => "50", 989 -onchange => $onChange, 990 ), 991 ($authz->hasPermissions($user, "assign_problem_sets")) 992 ? 993 "assigning this set to " . 994 CGI::popup_menu( 995 -name => "action.import.assign", 996 -value => [qw(all none)], 997 -default => $actionParams{"action.import.assign"}->[0] || "none", 998 -labels => { 999 all => "all current users.", 1000 none => "no users.", 1001 }, 1002 -onchange => $onChange, 1003 ) 1004 : 1005 "" #user does not have permissions to assign problem sets 1006 ); 1007 } 1008 1009 sub import_handler { 1010 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1011 1012 my @fileNames = @{ $actionParams->{"action.import.source"} }; 1013 my $newSetName = $actionParams->{"action.import.name"}->[0]; 1014 $newSetName = "" if $actionParams->{"action.import.number"}->[0] > 1; # cannot assign set names to multiple imports 1015 my $assign = $actionParams->{"action.import.assign"}->[0]; 1016 1017 my ($added, $skipped) = $self->importSetsFromDef($newSetName, $assign, @fileNames); 1018 1019 # make new sets visible... do we really want to do this? probably. 1020 push @{ $self->{visibleSetIDs} }, @$added; 1021 push @{ $self->{allSetIDs} }, @$added; 1022 1023 my $numAdded = @$added; 1024 my $numSkipped = @$skipped; 1025 1026 return $numAdded . " set" . ($numAdded == 1 ? "" : "s") . " added, " 1027 . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped" 1028 . " (" . join (", ", @$skipped) . ") "; 1029 } 1030 1031 sub export_form { 1032 my ($self, $onChange, %actionParams) = @_; 1033 1034 return join("", 1035 "Export ", 1036 CGI::popup_menu( 1037 -name => "action.export.scope", 1038 -values => [qw(all visible selected)], 1039 -default => $actionParams{"action.export.scope"}->[0] || "visible", 1040 -labels => { 1041 all => "all sets", 1042 visible => "visible sets", 1043 selected => "selected sets", 1044 }, 1045 -onchange => $onChange, 1046 ), 1047 ); 1048 } 1049 1050 # this does not actually export any files, rather it sends us to a new page in order to export the files 1051 sub export_handler { 1052 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1053 1054 my $result; 1055 1056 my $scope = $actionParams->{"action.export.scope"}->[0]; 1057 if ($scope eq "all") { 1058 $result = "exporting all sets"; 1059 $self->{selectedSetIDs} = $self->{visibleSetIDs} = $self->{allSetIDs}; 1060 1061 } elsif ($scope eq "visible") { 1062 $result = "exporting visible sets"; 1063 $self->{selectedSetIDs} = $self->{visibleSetIDs}; 1064 } elsif ($scope eq "selected") { 1065 $result = "exporting selected sets"; 1066 $self->{selectedSetIDs} = $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref 1067 } 1068 $self->{exportMode} = 1; 1069 1070 return $result; 1071 } 1072 1073 sub cancelExport_form { 1074 my ($self, $onChange, %actionParams) = @_; 1075 return "Abandon export"; 1076 } 1077 1078 sub cancelExport_handler { 1079 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1080 my $r = $self->r; 1081 1082 #$self->{selectedSetIDs) = $self->{visibleSetIDs}; 1083 # only do the above if we arrived here via "edit selected users" 1084 if (defined $r->param("prev_visible_sets")) { 1085 $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; 1086 } elsif (defined $r->param("no_prev_visible_sets")) { 1087 $self->{visibleSetIDs} = []; 1088 } else { 1089 # leave it alone 1090 } 1091 $self->{exportMode} = 0; 1092 1093 return "export abandoned"; 1094 } 1095 1096 sub saveExport_form { 1097 my ($self, $onChange, %actionParams) = @_; 1098 return "Export selected sets (This may take a long time. Even if your browser times out, all the files will be exported)."; 1099 } 1100 1101 sub saveExport_handler { 1102 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1103 my $r = $self->r; 1104 my $db = $r->db; 1105 1106 my @setIDsToExport = @{ $self->{selectedSetIDs} }; 1107 1108 my %filenames = map { $_ => (@{ $tableParams->{"set.$_"} }[0] || $_) } @setIDsToExport; 1109 1110 my ($exported, $skipped, $reason) = $self->exportSetsToDef(%filenames); 1111 1112 if (defined $r->param("prev_visible_sets")) { 1113 $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; 1114 } elsif (defined $r->param("no_prev_visble_sets")) { 1115 $self->{visibleSetIDs} = []; 1116 } else { 1117 # leave it alone 1118 } 1119 1120 $self->{exportMode} = 0; 1121 1122 my $numExported = @$exported; 1123 my $numSkipped = @$skipped; 1124 1125 my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason; 1126 1127 return $numExported . " set" . ($numExported == 1 ? "" : "s") . " exported, " 1128 . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped." 1129 . (($numSkipped) ? CGI::ul(CGI::li(\@reasons)) : ""); 1130 1131 } 1132 1133 sub cancelEdit_form { 1134 my ($self, $onChange, %actionParams) = @_; 1135 return "Abandon changes"; 1136 } 1137 1138 sub cancelEdit_handler { 1139 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1140 my $r = $self->r; 1141 1142 #$self->{selectedSetIDs) = $self->{visibleSetIDs}; 1143 # only do the above if we arrived here via "edit selected users" 1144 if (defined $r->param("prev_visible_sets")) { 1145 $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; 1146 } elsif (defined $r->param("no_prev_visible_sets")) { 1147 $self->{visibleSetIDs} = []; 1148 } else { 1149 # leave it alone 1150 } 1151 $self->{editMode} = 0; 1152 1153 return "changes abandoned"; 1154 } 1155 1156 sub saveEdit_form { 1157 my ($self, $onChange, %actionParams) = @_; 1158 return "Save changes"; 1159 } 1160 1161 sub saveEdit_handler { 1162 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1163 my $r = $self->r; 1164 my $db = $r->db; 1165 1166 my @visibleSetIDs = @{ $self->{visibleSetIDs} }; 1167 foreach my $setID (@visibleSetIDs) { 1168 my $Set = $db->getGlobalSet($setID); # checked 1169 # FIXME: we may not want to die on bad sets, they're not as bad as bad users 1170 die "record for visible set $setID not found" unless $Set; 1171 1172 foreach my $field ($Set->NONKEYFIELDS()) { 1173 my $param = "set.${setID}.${field}"; 1174 if (defined $tableParams->{$param}->[0]) { 1175 if ($field =~ /_date/) { 1176 $Set->$field($self->parseDateTime($tableParams->{$param}->[0])); 1177 } else { 1178 $Set->$field($tableParams->{$param}->[0]); 1179 } 1180 } 1181 } 1182 1183 ################################################### 1184 # Check that the open, due and answer dates are in increasing order. 1185 # Bail if this is not correct. 1186 ################################################### 1187 if ($Set->open_date > $Set->due_date) { 1188 return CGI::div({class=>'ResultsWithError'}, "Error: Due date must come after open date in set $setID"); 1189 } 1190 if ($Set->due_date > $Set->answer_date) { 1191 return CGI::div({class=>'ResultsWithError'}, "Error: Answer date must come after due date in set $setID"); 1192 } 1193 ################################################### 1194 # End date check section. 1195 ################################################### 1196 $db->putGlobalSet($Set); 1197 } 1198 1199 if (defined $r->param("prev_visible_sets")) { 1200 $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; 1201 } elsif (defined $r->param("no_prev_visble_sets")) { 1202 $self->{visibleSetIDs} = []; 1203 } else { 1204 # leave it alone 1205 } 1206 1207 $self->{editMode} = 0; 1208 1209 return "changes saved"; 1210 } 1211 1212 sub duplicate_form { 1213 my ($self, $onChange, %actionParams) = @_; 1214 1215 my $r = $self->r; 1216 my @visible_sets = $r->param('visible_sets'); 1217 1218 return "" unless @visible_sets == 1; 1219 1220 return join ("", 1221 "Duplicate this set and name it: ", 1222 CGI::textfield( 1223 -name => "action.duplicate.name", 1224 -value => $actionParams{"action.duplicate.name"}->[0] || "", 1225 -width => "50", 1226 -onchange => $onChange, 1227 ), 1228 ); 1229 } 1230 1231 sub duplicate_handler { 1232 my ($self, $genericParams, $actionParams, $tableParams) = @_; 1233 1234 my $r = $self->r; 1235 my $db = $r->db; 1236 1237 my $oldSetID = $self->{selectedSetIDs}->[0]; 1238 return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set selected for duplication!") unless defined($oldSetID) and $oldSetID =~ /\S/; 1239 my $newSetID = $actionParams->{"action.duplicate.name"}->[0]; 1240 return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set name specified!") unless $newSetID =~ /\S/; 1241 return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: set $newSetID already exists!") if defined $db->getGlobalSet($newSetID); 1242 1243 my $newSet = $db->getGlobalSet($oldSetID); 1244 $newSet->set_id($newSetID); 1245 eval {$db->addGlobalSet($newSet)}; 1246 1247 # take all the problems from the old set and make them part of the new set 1248 foreach ($db->getAllGlobalProblems($oldSetID)) { 1249 $_->set_id($newSetID); 1250 $db->addGlobalProblem($_); 1251 } 1252 1253 push @{ $self->{visibleSetIDs} }, $newSetID; 1254 1255 return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: $@") if $@; 1256 1257 return "SUCCESS"; 1258 } 1259 1260 ################################################################################ 1261 # sorts 1262 ################################################################################ 1263 1264 sub bySetID { $a->set_id cmp $b->set_id } 1265 sub bySetHeader { $a->set_header cmp $b->set_header } 1266 sub byHardcopyHeader { $a->hardcopy_header cmp $b->hardcopy_header } 1267 sub byOpenDate { $a->open_date <=> $b->open_date } 1268 sub byDueDate { $a->due_date <=> $b->due_date } 1269 sub byAnswerDate { $a->answer_date <=> $b->answer_date } 1270 sub byPublished { $a->published cmp $b->published } 1271 1272 sub byOpenDue { &byOpenDate || &byDueDate } 1273 1274 ################################################################################ 1275 # utilities 1276 ################################################################################ 1277 1278 # generate labels for open_date/due_date/answer_date popup menus 1279 sub menuLabels { 1280 my ($self, $hashRef) = @_; 1281 my %hash = %$hashRef; 1282 1283 my %result; 1284 foreach my $key (keys %hash) { 1285 my $count = @{ $hash{$key} }; 1286 my $displayKey = $self->formatDateTime($key) || "<none>"; 1287 $result{$key} = "$displayKey ($count sets)"; 1288 } 1289 return %result; 1290 } 1291 1292 sub importSetsFromDef { 1293 my ($self, $newSetName, $assign, @setDefFiles) = @_; 1294 my $r = $self->r; 1295 my $ce = $r->ce; 1296 my $db = $r->db; 1297 my $dir = $ce->{courseDirs}->{templates}; 1298 1299 # FIXME: do we really want everything to fail on one bad file name? 1300 foreach my $fileName (@setDefFiles) { 1301 die "won't be able to read from file $dir/$fileName: does it exist? is it readable?" 1302 unless -r "$dir/$fileName"; 1303 } 1304 1305 my @allSetIDs = $db->listGlobalSets(); 1306 # FIXME: getGlobalSets takes a lot of time just for checking to see if a set already exists 1307 # this could be avoided by waiting until the call to addGlobalSet below 1308 # and checking to see if the error message says that the set already exists 1309 # but if the error message is ever changed the code here might be broken 1310 # then again, one call to getGlobalSets and skipping unnecessary calls to addGlobalSet 1311 # could be faster than no call to getGlobalSets and lots of unnecessary calls to addGlobalSet 1312 my %allSets = map { $_->set_id => 1 if $_} $db->getGlobalSets(@allSetIDs); # checked 1313 1314 my (@added, @skipped); 1315 1316 foreach my $set_definition_file (@setDefFiles) { 1317 1318 $WeBWorK::timer->continue("$set_definition_file: reading set definition file") if defined $WeBWorK::timer; 1319 # read data in set definition file 1320 my ($setName, $paperHeaderFile, $screenHeaderFile, $openDate, $dueDate, $answerDate, $ra_problemData) = $self->readSetDef($set_definition_file); 1321 my @problemList = @{$ra_problemData}; 1322 1323 # Use the original name if form doesn't specify a new one. 1324 # The set acquires the new name specified by the form. A blank 1325 # entry on the form indicates that the imported set name will be used. 1326 $setName = $newSetName if $newSetName; 1327 1328 if ($allSets{$setName}) { 1329 # this set already exists!! 1330 push @skipped, $setName; 1331 next; 1332 } else { 1333 push @added, $setName; 1334 } 1335 1336 $WeBWorK::timer->continue("$set_definition_file: adding set") if defined $WeBWorK::timer; 1337 # add the data to the set record 1338 my $newSetRecord = $db->newGlobalSet; 1339 $newSetRecord->set_id($setName); 1340 $newSetRecord->set_header($screenHeaderFile); 1341 $newSetRecord->hardcopy_header($paperHeaderFile); 1342 $newSetRecord->open_date($openDate); 1343 $newSetRecord->due_date($dueDate); 1344 $newSetRecord->answer_date($answerDate); 1345 $newSetRecord->published(DEFAULT_PUBLISHED_STATE); 1346 1347 #create the set 1348 eval {$db->addGlobalSet($newSetRecord)}; 1349 die "addGlobalSet $setName in ProblemSetList: $@" if $@; 1350 1351 $WeBWorK::timer->continue("$set_definition_file: adding problems to database") if defined $WeBWorK::timer; 1352 # add problems 1353 my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; 1354 foreach my $rh_problem (@problemList) { 1355 $self->addProblemToSet( 1356 setName => $setName, 1357 sourceFile => $rh_problem->{source_file}, 1358 problemID => $freeProblemID++, 1359 value => $rh_problem->{value}, 1360 maxAttempts => $rh_problem->{max_attempts}); 1361 } 1362 1363 1364 if ($assign eq "all") { 1365 $self->assignSetToAllUsers($setName); 1366 } 1367 } 1368 1369 1370 return \@added, \@skipped; 1371 } 1372 1373 sub readSetDef { 1374 my ($self, $fileName) = @_; 1375 my $templateDir = $self->{ce}->{courseDirs}->{templates}; 1376 my $filePath = "$templateDir/$fileName"; 1377 1378 my $setName = ''; 1379 1380 if ($fileName =~ m|^set([\w-]+)\.def$|) { 1381 $setName = $1; 1382 } else { 1383 warn qq{The setDefinition file name must begin with <CODE>set</CODE>}, 1384 qq{and must end with <CODE>.def</CODE> . Every thing in between becomes the name of the set. }, 1385 qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> }, 1386 qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. }, 1387 qq{The filename, $fileName, you entered is not legal\n }; 1388 1389 } 1390 1391 my ($line, $name, $value, $attemptLimit, $continueFlag); 1392 my $paperHeaderFile = ''; 1393 my $screenHeaderFile = ''; 1394 my ($dueDate, $openDate, $answerDate); 1395 my @problemData; 1396 1397 1398 my %setInfo; 1399 if ( open (SETFILENAME, "$filePath") ) { 1400 ##################################################################### 1401 # Read and check set data 1402 ##################################################################### 1403 while (<SETFILENAME>) { 1404 1405 chomp($line = $_); 1406 $line =~ s|(#.*)||; ## don't read past comments 1407 unless ($line =~ /\S/) {next;} ## skip blank lines 1408 $line =~ s|\s*$||; ## trim trailing spaces 1409 $line =~ m|^\s*(\w+)\s*=\s*(.*)|; 1410 1411 ###################### 1412 # sanity check entries 1413 ###################### 1414 my $item = $1; 1415 $item = '' unless defined $item; 1416 my $value = $2; 1417 $value = '' unless defined $value; 1418 1419 if ($item eq 'setNumber') { 1420 next; 1421 } elsif ($item eq 'paperHeaderFile') { 1422 $paperHeaderFile = $value; 1423 } elsif ($item eq 'screenHeaderFile') { 1424 $screenHeaderFile = $value; 1425 } elsif ($item eq 'dueDate') { 1426 $dueDate = $value; 1427 } elsif ($item eq 'openDate') { 1428 $openDate = $value; 1429 } elsif ($item eq 'answerDate') { 1430 $answerDate = $value; 1431 } elsif ($item eq 'problemList') { 1432 last; 1433 } else { 1434 warn "readSetDef error, can't read the line: ||$line||"; 1435 } 1436 } 1437 1438 ##################################################################### 1439 # Check and format dates 1440 ##################################################################### 1441 my ($time1, $time2, $time3) = map { $self->parseDateTime($_); } ($openDate, $dueDate, $answerDate); 1442 1443 unless ($time1 <= $time2 and $time2 <= $time3) { 1444 warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronological order."; 1445 } 1446 1447 # Check header file names 1448 $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space 1449 $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space 1450 1451 ##################################################################### 1452 # Read and check list of problems for the set 1453 ##################################################################### 1454 while(<SETFILENAME>) { 1455 chomp($line=$_); 1456 $line =~ s/(#.*)//; ## don't read past comments 1457 unless ($line =~ /\S/) {next;} ## skip blank lines 1458 1459 ($name, $value, $attemptLimit, $continueFlag) = split (/\s*,\s*/,$line); 1460 ##################### 1461 # clean up problem values 1462 ########################### 1463 $name =~ s/\s*//g; 1464 $value = "" unless defined($value); 1465 $value =~ s/[^\d\.]*//g; 1466 unless ($value =~ /\d+/) {$value = 1;} 1467 $attemptLimit = "" unless defined($attemptLimit); 1468 $attemptLimit =~ s/[^\d-]*//g; 1469 unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;} 1470 $continueFlag = "0" unless( defined($continueFlag) && @problemData ); 1471 # can't put continuation flag onto the first problem 1472 push(@problemData, {source_file => $name, 1473 value => $value, 1474 max_attempts =>, $attemptLimit, 1475 continuation => $continueFlag 1476 }); 1477 } 1478 close(SETFILENAME); 1479 ($setName, 1480 $paperHeaderFile, 1481 $screenHeaderFile, 1482 $time1, 1483 $time2, 1484 $time3, 1485 \@problemData, 1486 ); 1487 } else { 1488 warn "Can't open file $filePath\n"; 1489 } 1490 } 1491 1492 sub exportSetsToDef { 1493 my ($self, %filenames) = @_; 1494 1495 my $r = $self->r; 1496 my $ce = $r->ce; 1497 my $db = $r->db; 1498 1499 my (@exported, @skipped, %reason); 1500 1501 SET: foreach my $set (keys %filenames) { 1502 1503 my $fileName = $filenames{$set}; 1504 $fileName .= ".def" unless $fileName =~ m/\.def$/; 1505 $fileName = "set" . $fileName unless $fileName =~ m/^set/; 1506 # files can be exported to sub directories but not parent directories 1507 if ($fileName =~ /\.\./) { 1508 push @skipped, $set; 1509 $reason{$set} = "Illegal filename contains '..'"; 1510 next SET; 1511 } 1512 1513 my $setRecord = $db->getGlobalSet($set); 1514 unless (defined $setRecord) { 1515 push @skipped, $set; 1516 $reason{$set} = "No record found."; 1517 next SET; 1518 } 1519 my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName; 1520 1521 # back up existing file 1522 if(-e $filePath) { 1523 rename($filePath, "$filePath.bak") or 1524 $reason{$set} = "Existing file $filePath could not be backed up and was lost."; 1525 } 1526 1527 my $openDate = $self->formatDateTime($setRecord->open_date); 1528 my $dueDate = $self->formatDateTime($setRecord->due_date); 1529 my $answerDate = $self->formatDateTime($setRecord->answer_date); 1530 my $setHeader = $setRecord->set_header; 1531 my $paperHeader = $setRecord->hardcopy_header; 1532 my @problemList = $db->listGlobalProblems($set); 1533 1534 my $problemList = ''; 1535 foreach my $prob (sort {$a <=> $b} @problemList) { 1536 my $problemRecord = $db->getGlobalProblem($set, $prob); # checked 1537 unless (defined $problemRecord) { 1538 push @skipped, $set; 1539 $reason{$set} = "No record found for problem $prob."; 1540 next SET; 1541 } 1542 my $source_file = $problemRecord->source_file(); 1543 my $value = $problemRecord->value(); 1544 my $max_attempts = $problemRecord->max_attempts(); 1545 $problemList .= "$source_file, $value, $max_attempts \n"; 1546 } 1547 my $fileContents = <<EOF; 1548 1549 openDate = $openDate 1550 dueDate = $dueDate 1551 answerDate = $answerDate 1552 paperHeaderFile = $paperHeader 1553 screenHeaderFile = $setHeader 1554 problemList = 1555 1556 $problemList 1557 1558 1559 1560 EOF 1561 1562 $filePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $filePath); 1563 eval { 1564 local *SETDEF; 1565 open SETDEF, ">$filePath" or die "Failed to open $filePath"; 1566 print SETDEF $fileContents; 1567 close SETDEF; 1568 }; 1569 1570 if ($@) { 1571 push @skipped, $set; 1572 $reason{$set} = $@; 1573 } else { 1574 push @exported, $set; 1575 } 1576 1577 } 1578 1579 return \@exported, \@skipped, \%reason; 1580 1581 } 1582 1583 ################################################################################ 1584 # "display" methods 1585 ################################################################################ 1586 1587 sub fieldEditHTML { 1588 my ($self, $fieldName, $value, $properties) = @_; 1589 my $size = $properties->{size}; 1590 my $type = $properties->{type}; 1591 my $access = $properties->{access}; 1592 my $items = $properties->{items}; 1593 my $synonyms = $properties->{synonyms}; 1594 my $headerFiles = $self->{headerFiles}; 1595 1596 if ($access eq "readonly") { 1597 return $value; 1598 } 1599 1600 if ($type eq "number" or $type eq "text") { 1601 return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size}); 1602 } 1603 1604 if ($type eq "filelist") { 1605 return CGI::popup_menu({ 1606 name => $fieldName, 1607 value => [ sort keys %$headerFiles ], 1608 labels => $headerFiles, 1609 default => $value || 0, 1610 }); 1611 } 1612 1613 if ($type eq "enumerable") { 1614 my $matched = undef; # Whether a synonym match has occurred 1615 1616 # Process synonyms for enumerable objects 1617 foreach my $synonym (keys %$synonyms) { 1618 if ($synonym ne "*" and $value =~ m/$synonym/) { 1619 $value = $synonyms->{$synonym}; 1620 $matched = 1; 1621 } 1622 } 1623 1624 if (!$matched and exists $synonyms->{"*"}) { 1625 $value = $synonyms->{"*"}; 1626 } 1627 1628 return CGI::popup_menu({ 1629 name => $fieldName, 1630 values => [keys %$items], 1631 default => $value, 1632 labels => $items, 1633 }); 1634 } 1635 1636 if ($type eq "checked") { 1637 1638 # FIXME: kludge (R) 1639 # if the checkbox is checked it returns a 1, if it is unchecked it returns nothing 1640 # in which case the hidden field overrides the parameter with a 0 1641 return CGI::checkbox( 1642 -name => $fieldName, 1643 -checked => $value, 1644 -label => "", 1645 -value => 1 1646 ) . CGI::hidden( 1647 -name => $fieldName, 1648 -value => 0 1649 ); 1650 } 1651 } 1652 1653 sub recordEditHTML { 1654 my ($self, $Set, %options) = @_; 1655 my $r = $self->r; 1656 my $urlpath = $r->urlpath; 1657 my $ce = $r->ce; 1658 my $db = $r->db; 1659 my $authz = $r->authz; 1660 my $user = $r->param('user'); 1661 my $root = $ce->{webworkURLs}->{root}; 1662 my $courseName = $urlpath->arg("courseID"); 1663 1664 my $editMode = $options{editMode}; 1665 my $exportMode = $options{exportMode}; 1666 my $setSelected = $options{setSelected}; 1667 1668 my $publishedClass = $Set->published ? "Published" : "Unpublished"; 1669 1670 my $users = $db->countSetUsers($Set->set_id); 1671 my $totalUsers = $self->{totalUsers}; 1672 my $problems = $db->listGlobalProblems($Set->set_id); 1673 1674 my $usersAssignedToSetURL = $self->systemLink($urlpath->new(type=>'instructor_users_assigned_to_set', args=>{courseID => $courseName, setID => $Set->set_id} )); 1675 my $problemListURL = $self->systemLink($urlpath->new(type=>'instructor_set_detail', args=>{courseID => $courseName, setID => $Set->set_id} )); 1676 my $problemSetListURL = $self->systemLink($urlpath->new(type=>'instructor_set_list', args=>{courseID => $courseName, setID => $Set->set_id})) . "&editMode=1&visible_sets=" . $Set->set_id; 1677 my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/edit.gif"; 1678 my $imageLink = CGI::a({href => $problemSetListURL}, CGI::img({src=>$imageURL, border=>0})); 1679 1680 my @tableCells; 1681 my %fakeRecord; 1682 my $set_id = $Set->set_id; 1683 1684 $fakeRecord{select} = CGI::checkbox(-name => "selected_sets", -value => $set_id, -checked => $setSelected, -label => "", ); 1685 # $fakeRecord{set_id} = CGI::font({class=>$publishedClass}, $set_id) . ($editMode ? "" : $imageLink); 1686 $fakeRecord{set_id} = $editMode 1687 ? CGI::a({href=>$problemListURL}, "$set_id") 1688 : CGI::font({class=>$publishedClass}, $set_id) . $imageLink; 1689 $fakeRecord{problems} = (FIELD_PERMS()->{problems} and not $authz->hasPermissions($user, FIELD_PERMS()->{problems})) 1690 ? "$problems" 1691 : CGI::a({href=>$problemListURL}, "$problems"); 1692 $fakeRecord{users} = (FIELD_PERMS()->{users} and not $authz->hasPermissions($user, FIELD_PERMS()->{users})) 1693 ? "$users/$totalUsers" 1694 : CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers"); 1695 $fakeRecord{filename} = CGI::input({-name => "set.$set_id", -value=>"set$set_id.def", -size=>60}); 1696 1697 1698 # Select 1699 if ($editMode) { 1700 # column not there 1701 } else { 1702 # selection checkbox 1703 push @tableCells, CGI::checkbox( 1704 -name => "selected_sets", 1705 -value => $set_id, 1706 -checked => $setSelected, 1707 -label => "", 1708 ); 1709 } 1710 1711 # Set ID 1712 if ($editMode) { 1713 push @tableCells, CGI::a({href=>$problemListURL}, "$set_id"); 1714 } else { 1715 push @tableCells, CGI::font({class=>$publishedClass}, $set_id . $imageLink); 1716 } 1717 1718 # Problems link 1719 if ($editMode) { 1720 # column not there 1721 } else { 1722 # "problem list" link 1723 push @tableCells, CGI::a({href=>$problemListURL}, "$problems"); 1724 } 1725 1726 # Users link 1727 if ($editMode) { 1728 # column not there 1729 } else { 1730 # "edit users assigned to set" link 1731 push @tableCells, CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers"); 1732 } 1733 1734 # Set Fields 1735 foreach my $field ($Set->NONKEYFIELDS) { 1736 my $fieldName = "set." . $set_id . "." . $field, 1737 my $fieldValue = $Set->$field; 1738 my %properties = %{ FIELD_PROPERTIES()->{$field} }; 1739 $properties{access} = "readonly" unless $editMode; 1740 $fieldValue = $self->formatDateTime($fieldValue) if $field =~ /_date/; 1741 $fieldValue =~ s/ / /g unless $editMode; 1742 $fieldValue = ($fieldValue) ? "Yes" : "No" if $field =~ /published/ and not $editMode; 1743 push @tableCells, CGI::font({class=>$publishedClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); 1744 $fakeRecord{$field} = CGI::font({class=>$publishedClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); 1745 } 1746 1747 my @fieldsToShow; 1748 if ($editMode) { 1749 @fieldsToShow = @{ EDIT_FIELD_ORDER() }; 1750 } else { 1751 @fieldsToShow = @{ VIEW_FIELD_ORDER() }; 1752 } 1753 1754 if ($exportMode) { 1755 @fieldsToShow = @{ EXPORT_FIELD_ORDER() }; 1756 } 1757 1758 @tableCells = map { $fakeRecord{$_} } @fieldsToShow; 1759 1760 return CGI::Tr({}, CGI::td({}, \@tableCells)); 1761 } 1762 1763 sub printTableHTML { 1764 my ($self, $SetsRef, $fieldNamesRef, %options) = @_; 1765 my $r = $self->r; 1766 my $authz = $r->authz; 1767 my $user = $r->param('user'); 1768 my $setTemplate = $self->{setTemplate}; 1769 my @Sets = @$SetsRef; 1770 my %fieldNames = %$fieldNamesRef; 1771 1772 my $editMode = $options{editMode}; 1773 my $exportMode = $options{exportMode}; 1774 my %selectedSetIDs = map { $_ => 1 } @{ $options{selectedSetIDs} }; 1775 my $currentSort = $options{currentSort}; 1776 1777 # names of headings: 1778 my @realFieldNames = ( 1779 $setTemplate->KEYFIELDS, 1780 $setTemplate->NONKEYFIELDS, 1781 ); 1782 1783 if ($editMode) { 1784 @realFieldNames = @{ EDIT_FIELD_ORDER() }; 1785 } else { 1786 @realFieldNames = @{ VIEW_FIELD_ORDER() }; 1787 } 1788 1789 if ($exportMode) { 1790 @realFieldNames = @{ EXPORT_FIELD_ORDER() }; 1791 } 1792 1793 1794 my %sortSubs = %{ SORT_SUBS() }; 1795 1796 # FIXME: should this always presume to use the templates directory? 1797 # (no, but that can wait until we have an abstract ProblemLibrary API -- sam) 1798 my $templates_dir = $r->ce->{courseDirs}->{templates}; 1799 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} }; 1800 my $exempt_dirs = join("|", keys %probLibs); 1801 my @headers = listFilesRecursive( 1802 $templates_dir, 1803 qr/header.*\.pg$/i, # match these files 1804 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories 1805 0, # match against file name only 1806 1, # prune against path relative to $templates_dir 1807 ); 1808 1809 @headers = sort @headers; 1810 my %headers = map { $_ => $_ } @headers; 1811 $headers{""} = "Use System Default"; 1812 $self->{headerFiles} = \%headers; # store these header files so we don't have to look for them later. 1813 1814 1815 my @tableHeadings = map { $fieldNames{$_} } @realFieldNames; 1816 1817 # prepend selection checkbox? only if we're NOT editing! 1818 # unshift @tableHeadings, "Select", "Set", "Problems" unless $editMode; 1819 1820 # print the table 1821 if ($editMode or $exportMode) { 1822 print CGI::start_table({}); 1823 } else { 1824 print CGI::start_table({-border=>1}); 1825 } 1826 1827 print CGI::Tr({}, CGI::th({}, \@tableHeadings)); 1828 1829 1830 for (my $i = 0; $i < @Sets; $i++) { 1831 my $Set = $Sets[$i]; 1832 1833 print $self->recordEditHTML($Set, 1834 editMode => $editMode, 1835 exportMode => $exportMode, 1836 setSelected => exists $selectedSetIDs{$Set->set_id} 1837 ); 1838 } 1839 1840 print CGI::end_table(); 1841 ######################################### 1842 # if there are no users shown print message 1843 # 1844 ########################################## 1845 1846 print CGI::p( 1847 CGI::i("No sets shown. Choose one of the options above to list the sets in the course.") 1848 ) unless @Sets; 1849 } 1850 1851 1; 1852 1853 =head1 AUTHOR 1854 1855 Written by Robert Van Dam, toenail (at) cif.rochester.edu 1856 1857 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |