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