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