[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / ProblemSetList.pm Repository:
ViewVC logotype

View of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6963 - (download) (as text) (annotate)
Tue Jul 19 23:42:14 2011 UTC (6 years, 4 months ago) by gage
File size: 75013 byte(s)
updating small changes -- moving toward Grant's accessibility code


    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 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);
   19 use base qw(WeBWorK::ContentGenerator::Instructor);
   20 
   21 =head1 NAME
   22 
   23 WeBWorK::ContentGenerator::Instructor::ProblemSetList - Entry point for Set-specific
   24 data editing/viewing
   25 
   26 =cut
   27 
   28 =for comment
   29 
   30 What do we want to be able to do here?
   31 
   32 filter sort edit publish import create delete
   33 
   34 Filter what sets are shown:
   35   - none, all, selected
   36   - matching set_id, visible to students, hidden from students
   37 
   38 Sort sets by:
   39   - set name
   40   - open date
   41   - due date
   42   - answer date
   43   - header files
   44   - visibility to students
   45 
   46 Switch from view mode to edit mode:
   47   - showing visible sets
   48   - showing selected sets
   49 Switch from edit mode to view and save changes
   50 Switch from edit mode to view and abandon changes
   51 
   52 Make sets visible to or hidden from students:
   53   - all, selected
   54 
   55 Import sets:
   56   - replace:
   57     - any users
   58     - visible users
   59     - selected users
   60     - no users
   61   - add:
   62     - any users
   63     - no users
   64 
   65 Score sets:
   66   - all
   67   - visible
   68   - selected
   69 
   70 Create a set with a given name
   71 
   72 Delete sets:
   73   - visible
   74   - selected
   75 
   76 =cut
   77 
   78 # FIXME: rather than having two types of boolean modes $editMode and $exportMode
   79 # make one $mode variable that contains a string like "edit", "view", or "export"
   80 
   81 use strict;
   82 use warnings;
   83 #use CGI qw(-nosticky );
   84 use WeBWorK::CGI;
   85 use WeBWorK::Debug;
   86 use WeBWorK::Utils qw(timeToSec readFile listFilesRecursive cryptPassword sortByName);
   87 
   88 use constant HIDE_SETS_THRESHOLD => 500;
   89 use constant DEFAULT_VISIBILITY_STATE => 1;
   90 use constant DEFAULT_ENABLED_REDUCED_SCORING_STATE => 0;
   91 use constant ONE_WEEK => 60*60*24*7;
   92 
   93 use constant EDIT_FORMS => [qw(cancelEdit saveEdit)];
   94 use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)];
   95 use constant EXPORT_FORMS => [qw(cancelExport saveExport)];
   96 
   97 use constant VIEW_FIELD_ORDER => [ qw( select set_id problems users visible enable_reduced_scoring open_date due_date answer_date) ];
   98 use constant EDIT_FIELD_ORDER => [ qw( set_id visible enable_reduced_scoring open_date due_date answer_date) ];
   99 use constant EXPORT_FIELD_ORDER => [ qw( select set_id filename) ];
  100 
  101 # permissions needed to perform a given action
  102 use constant FORM_PERMS => {
  103     saveEdit => "modify_problem_sets",
  104     edit => "modify_problem_sets",
  105     publish => "modify_problem_sets",
  106     import => "create_and_delete_problem_sets",
  107     export => "modify_set_def_files",
  108     saveExport => "modify_set_def_files",
  109     score => "score_sets",
  110     create => "create_and_delete_problem_sets",
  111     delete => "create_and_delete_problem_sets",
  112 };
  113 
  114 # permissions needed to view a given field
  115 use constant FIELD_PERMS => {
  116     problems => "modify_problem_sets",
  117     users => "assign_problem_sets",
  118 };
  119 
  120 use constant STATE_PARAMS => [qw(user effectiveUser key visible_sets no_visible_sets prev_visible_sets no_prev_visible_set editMode exportMode primarySortField secondarySortField)];
  121 
  122 use constant SORT_SUBS => {
  123   set_id    => \&bySetID,
  124 # set_header  => \&bySetHeader,  # can't figure out why these are useful
  125 # hardcopy_header => \&byHardcopyHeader,  # can't figure out why these are useful
  126   open_date => \&byOpenDate,
  127   due_date  => \&byDueDate,
  128   answer_date => \&byAnswerDate,
  129   visible => \&byVisible,
  130 
  131 };
  132 
  133 # note that field_properties for some fields, in particular, gateway
  134 # parameters, are not currently shown in the edit or display tables
  135 use constant  FIELD_PROPERTIES => {
  136   set_id => {
  137     type => "text",
  138     size => 8,
  139     access => "readonly",
  140   },
  141   set_header => {
  142     type => "filelist",
  143     size => 10,
  144     access => "readonly",
  145   },
  146   hardcopy_header => {
  147     type => "filelist",
  148     size => 10,
  149     access => "readonly",
  150   },
  151   open_date => {
  152     type => "text",
  153     size => 26,
  154     access => "readwrite",
  155   },
  156   due_date => {
  157     type => "text",
  158     size => 26,
  159     access => "readwrite",
  160   },
  161   answer_date => {
  162     type => "text",
  163     size => 26,
  164     access => "readwrite",
  165   },
  166   visible => {
  167     type => "checked",
  168     size => 4,
  169     access => "readwrite",
  170   },
  171   enable_reduced_scoring => {
  172     type => "checked",
  173     size => 4,
  174     access => "readwrite",
  175   },
  176   assignment_type => {
  177     type => "text",
  178     size => 20,
  179     access => "readwrite",
  180   },
  181   attempts_per_version => {
  182     type => "text",
  183     size => 4,
  184     access => "readwrite",
  185   },
  186   time_interval => {
  187     type => "text",
  188     size => 10,
  189     access => "readwrite",
  190   },
  191   versions_per_interval => {
  192     type => "text",
  193     size => 4,
  194     access => "readwrite",
  195   },
  196   version_time_limit => {
  197     type => "text",
  198     size => 10,
  199     access => "readwrite",
  200   },
  201   problem_randorder => {
  202     type => "text",
  203     size => 4,
  204     access => "readwrite",
  205   },
  206   problems_per_page => {
  207     type => "text",
  208     size => 4,
  209     access => "readwrite",
  210   },
  211   version_creation_time => {
  212     type => "text",
  213     size => 10,
  214     access => "readonly",
  215   },
  216   version_last_attempt_time => {
  217     type => "text",
  218     size => 10,
  219     access => "readonly",
  220   },
  221   # hide_score and hide_work should be drop down selects with
  222   #    options 'N', 'Y' and 'BeforeAnswerDate'.  in that we don't
  223   #    allow editing of these fields in this module, this is moot.
  224   hide_score => {
  225     type => "text",
  226     size => 16,
  227     access => "readwrite",
  228   },
  229   hide_work => {
  230     type => "text",
  231     size => 16,
  232     access => "readwrite",
  233   },
  234   time_limit_cap => {
  235     type => "checked",
  236     size => 4,
  237     access => "readwrite",
  238   },
  239   # this should be 'No', 'RestrictTo' or 'DenyFrom'
  240   restrict_ip => {
  241     type => "text",
  242     size => 10,
  243     access => "readwrite",
  244   }
  245 };
  246 
  247 sub pre_header_initialize {
  248   my ($self) = @_;
  249   my $r      = $self->r;
  250   my $db     = $r->db;
  251   my $ce     = $r->ce;
  252   my $authz  = $r->authz;
  253   my $urlpath = $r->urlpath;
  254   my $user   = $r->param('user');
  255   my $courseName = $urlpath->arg("courseID");
  256 
  257 
  258   # Check permissions
  259   return unless $authz->hasPermissions($user, "access_instructor_tools");
  260 
  261   if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) {
  262     my $scope = $r->param("action.score.scope");
  263     my @setsToScore = ();
  264 
  265     if ($scope eq "none") {
  266       return "No sets selected for scoring.";
  267     } elsif ($scope eq "all") {
  268       @setsToScore = @{ $r->param("allSetIDs") };
  269     } elsif ($scope eq "visible") {
  270       @setsToScore = @{ $r->param("visibleSetIDs") };
  271     } elsif ($scope eq "selected") {
  272       @setsToScore = $r->param("selected_sets");
  273     }
  274 
  275     my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', $r, courseID=>$courseName),
  276             params=>{
  277               scoreSelected=>"ScoreSelected",
  278               selectedSet=>\@setsToScore,
  279 #             recordSingleSetScores=>''
  280             }
  281     );
  282 
  283     $self->reply_with_redirect($uri);
  284   }
  285 
  286 }
  287 
  288 sub initialize {
  289 
  290   my ($self)       = @_;
  291   my $r            = $self->r;
  292   my $urlpath      = $r->urlpath;
  293   my $db           = $r->db;
  294   my $ce           = $r->ce;
  295   my $authz        = $r->authz;
  296   my $courseName   = $urlpath->arg("courseID");
  297   my $setID        = $urlpath->arg("setID");
  298   my $user         = $r->param('user');
  299 
  300 
  301   my $root = $ce->{webworkURLs}->{root};
  302 
  303   # templates for getting field names
  304   my $setTemplate = $self->{setTemplate} = $db->newGlobalSet;
  305 
  306   return CGI::div({class => "ResultsWithError"}, "You are not authorized to access the Instructor tools.")
  307     unless $authz->hasPermissions($user, "access_instructor_tools");
  308 
  309   ########## set initial values for state fields
  310 
  311   my @allSetIDs = $db->listGlobalSets;
  312   # DBFIXME count would suffice here :P
  313   my @users = $db->listUsers;
  314   $self->{allSetIDs} = \@allSetIDs;
  315   $self->{totalUsers} = scalar @users;
  316 
  317   if (defined $r->param("visible_sets")) {
  318     $self->{visibleSetIDs} = [ $r->param("visible_sets") ];
  319   } elsif (defined $r->param("no_visible_sets")) {
  320     $self->{visibleSetIDs} = [];
  321   } else {
  322     if (@allSetIDs > HIDE_SETS_THRESHOLD) {
  323       $self->{visibleSetIDs} = [];
  324     } else {
  325       $self->{visibleSetIDs} = [ @allSetIDs ];
  326     }
  327   }
  328 
  329   $self->{prevVisibleSetIDs} = $self->{visibleSetIDs};
  330 
  331   if (defined $r->param("selected_sets")) {
  332     $self->{selectedSetIDs} = [ $r->param("selected_sets") ];
  333   } else {
  334     $self->{selectedSetIDs} = [];
  335   }
  336 
  337   $self->{editMode} = $r->param("editMode") || 0;
  338 
  339   return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify homework sets."))
  340     if $self->{editMode} and not $authz->hasPermissions($user, "modify_problem_sets");
  341 
  342   $self->{exportMode} = $r->param("exportMode") || 0;
  343 
  344   return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify set definition files."))
  345     if $self->{exportMode} and not $authz->hasPermissions($user, "modify_set_def_files");
  346 
  347   $self->{primarySortField} = $r->param("primarySortField") || "due_date";
  348   $self->{secondarySortField} = $r->param("secondarySortField") || "open_date";
  349 
  350 
  351   #########################################
  352   # collect date information from sets
  353   #########################################
  354 
  355   my @allSets = $db->getGlobalSets(@allSetIDs);
  356 
  357   my (%open_dates, %due_dates, %answer_dates);
  358   foreach my $Set (@allSets) {
  359     push @{$open_dates{defined $Set->open_date ? $Set->open_date : ""}}, $Set->set_id;
  360     push @{$due_dates{defined $Set->due_date ? $Set->due_date : ""}}, $Set->set_id;
  361     push @{$answer_dates{defined $Set->answer_date ? $Set->answer_date : ""}}, $Set->set_id;
  362   }
  363   $self->{open_dates} = \%open_dates;
  364   $self->{due_dates} = \%due_dates;
  365   $self->{answer_dates} = \%answer_dates;
  366 
  367   #########################################
  368   #  call action handler
  369   #########################################
  370 
  371   my $actionID = $r->param("action");
  372   $self->{actionID} = $actionID;
  373   if ($actionID) {
  374     unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) {
  375       die "Action $actionID not found";
  376     }
  377     # Check permissions
  378     if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) {
  379       my $actionHandler = "${actionID}_handler";
  380       my %genericParams;
  381       foreach my $param (qw(selected_sets)) {
  382         $genericParams{$param} = [ $r->param($param) ];
  383       }
  384       my %actionParams = $self->getActionParams($actionID);
  385       my %tableParams = $self->getTableParams();
  386       $self->addmessage( CGI::div({class=>"Message"}, "Results of last action performed: "));
  387       $self->addmessage(
  388                            $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams),
  389                            CGI::hr()
  390       );
  391     } else {
  392       return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to perform this action."));
  393     }
  394 
  395 
  396 
  397   } else {
  398 
  399     $self->addgoodmessage("Please select action to be performed.");
  400   }
  401 
  402 
  403 }
  404 
  405 sub body {
  406   my ($self)       = @_;
  407   my $r            = $self->r;
  408   my $urlpath      = $r->urlpath;
  409   my $db           = $r->db;
  410   my $ce           = $r->ce;
  411   my $authz        = $r->authz;
  412   my $courseName   = $urlpath->arg("courseID");
  413   my $setID        = $urlpath->arg("setID");
  414   my $user         = $r->param('user');
  415 
  416   my $root = $ce->{webworkURLs}->{root};
  417 
  418   # templates for getting field names
  419   my $setTemplate = $self->{setTemplate} = $db->newGlobalSet;
  420 
  421   return CGI::div({class => "ResultsWithError"}, "You are not authorized to access the Instructor tools.")
  422     unless $authz->hasPermissions($user, "access_instructor_tools");
  423 
  424   # This table can be consulted when display-ready forms of field names are needed.
  425   my %prettyFieldNames = map { $_ => $_ }
  426     $setTemplate->FIELDS();
  427 
  428   @prettyFieldNames{qw(
  429     select
  430     problems
  431     users
  432     filename
  433     set_id
  434     set_header
  435     hardcopy_header
  436     open_date
  437     due_date
  438     answer_date
  439     visible
  440     enable_reduced_scoring
  441   )} = (
  442     "Select",
  443     "Edit<br> Problems",
  444     "Edit<br> Assigned Users",
  445     "Set Definition Filename",
  446     "Edit<br> Set Data",
  447     "Set Header",
  448     "Hardcopy Header",
  449     "Open Date",
  450     "Due Date",
  451     "Answer Date",
  452     "Visible",
  453     "Reduced Credit<br> Enabled"
  454   );
  455 
  456 
  457 
  458   my $actionID = $self->{actionID};
  459 
  460   ########## retrieve possibly changed values for member fields
  461 
  462   my @allSetIDs = @{ $self->{allSetIDs} }; # do we need this one? YES, deleting or importing a set will change this.
  463   my @visibleSetIDs = @{ $self->{visibleSetIDs} };
  464   my @prevVisibleSetIDs = @{ $self->{prevVisibleSetIDs} };
  465   my @selectedSetIDs = @{ $self->{selectedSetIDs} };
  466   my $editMode = $self->{editMode};
  467   my $exportMode = $self->{exportMode};
  468   my $primarySortField = $self->{primarySortField};
  469   my $secondarySortField = $self->{secondarySortField};
  470 
  471   #warn "visibleSetIDs=@visibleSetIDs\n";
  472   #warn "prevVisibleSetIDs=@prevVisibleSetIDs\n";
  473   #warn "selectedSetIDs=@selectedSetIDs\n";
  474   #warn "editMode=$editMode\n";
  475   #warn "exportMode = $exportMode\n";
  476 
  477   ########## get required users
  478 
  479   # DBFIXME use an iterator
  480   my @Sets = grep { defined $_ } @visibleSetIDs ? $db->getGlobalSets(@visibleSetIDs) : ();
  481 
  482   # presort users
  483   my %sortSubs = %{ SORT_SUBS() };
  484   my $primarySortSub = $sortSubs{$primarySortField};
  485   my $secondarySortSub = $sortSubs{$secondarySortField};
  486 
  487   # don't forget to sort in opposite order of importance
  488   if ($secondarySortField eq "set_id") {
  489     @Sets = sortByName("set_id", @Sets);
  490   } else {
  491     @Sets = sort $secondarySortSub @Sets;
  492   }
  493 
  494   if ($primarySortField eq "set_id") {
  495     @Sets = sortByName("set_id", @Sets);
  496   } else {
  497     @Sets = sort $primarySortSub @Sets;
  498   }
  499 
  500   ########## print beginning of form
  501 
  502   print CGI::start_form({method=>"post", action=>$self->systemLink($urlpath,authen=>0), name=>"problemsetlist"});
  503   print $self->hidden_authen_fields();
  504 
  505   ########## print state data
  506 
  507   print "\n<!-- state data here -->\n";
  508 
  509   if (@visibleSetIDs) {
  510     print CGI::hidden(-name=>"visible_sets", -value=>\@visibleSetIDs);
  511   } else {
  512     print CGI::hidden(-name=>"no_visible_sets", -value=>"1");
  513   }
  514 
  515   if (@prevVisibleSetIDs) {
  516     print CGI::hidden(-name=>"prev_visible_sets", -value=>\@prevVisibleSetIDs);
  517   } else {
  518     print CGI::hidden(-name=>"no_prev_visible_sets", -value=>"1");
  519   }
  520 
  521   print CGI::hidden(-name=>"editMode", -value=>$editMode);
  522   print CGI::hidden(-name=>"exportMode", -value=>$exportMode);
  523 
  524   print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField);
  525   print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField);
  526 
  527   print "\n<!-- state data here -->\n";
  528 
  529   ########## print action forms
  530 
  531   print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")) if $editMode;
  532 
  533   print CGI::start_table({});
  534   print CGI::Tr({}, CGI::td({-colspan=>2}, "Select an action to perform:"));
  535 
  536   my @formsToShow;
  537   if ($editMode) {
  538     @formsToShow = @{ EDIT_FORMS() };
  539   } else {
  540     @formsToShow = @{ VIEW_FORMS() };
  541   }
  542 
  543   if ($exportMode) {
  544     @formsToShow = @{ EXPORT_FORMS() };
  545   }
  546 
  547   my $i = 0;
  548   foreach my $actionID (@formsToShow) {
  549     # Check permissions
  550     next if FORM_PERMS()->{$actionID} and not $authz->hasPermissions($user, FORM_PERMS()->{$actionID});
  551     my $actionForm = "${actionID}_form";
  552     my $onChange = "document.problemsetlist.action[$i].checked=true";
  553     my %actionParams = $self->getActionParams($actionID);
  554 
  555     print CGI::Tr({-valign=>"top"},
  556       CGI::td({}, CGI::input({-type=>"radio", -name=>"action", -value=>$actionID})),
  557       CGI::td({}, $self->$actionForm($onChange, %actionParams))
  558     );
  559 
  560     $i++;
  561   }
  562 
  563   my $selectAll =CGI::input({-type=>'button', -name=>'check_all', -value=>'Select all sets',
  564          onClick => "for (i in document.problemsetlist.elements)  {
  565                          if (document.problemsetlist.elements[i].name =='selected_sets') {
  566                              document.problemsetlist.elements[i].checked = true
  567                          }
  568                       }" });
  569     my $selectNone =CGI::input({-type=>'button', -name=>'check_none', -value=>'Unselect all sets',
  570          onClick => "for (i in document.problemsetlist.elements)  {
  571                          if (document.problemsetlist.elements[i].name =='selected_sets') {
  572                             document.problemsetlist.elements[i].checked = false
  573                          }
  574                       }" });
  575   unless ($editMode or $exportMode) {
  576     print CGI::Tr({}, CGI::td({ colspan=>2, -align=>"center"},
  577       $selectAll." ". $selectNone
  578       )
  579     );
  580   }
  581   print CGI::Tr({}, CGI::td({-colspan=>2, -align=>"center"},
  582     CGI::submit(-value=>"Take Action!"))
  583   );
  584   print CGI::end_table();
  585 
  586   ########## print table
  587 
  588   ########## first adjust heading if in editMode
  589   $prettyFieldNames{set_id} = "Edit All <br> Set Data" if $editMode;
  590   $prettyFieldNames{enable_reduced_scoring} = 'Enable Reduced<br>Credit' if $editMode;
  591 
  592 
  593   print CGI::p({},"Showing ", scalar @visibleSetIDs, " out of ", scalar @allSetIDs, " sets.");
  594 
  595   $self->printTableHTML(\@Sets, \%prettyFieldNames,
  596     editMode => $editMode,
  597     exportMode => $exportMode,
  598     selectedSetIDs => \@selectedSetIDs,
  599   );
  600 
  601 
  602   ########## print end of form
  603 
  604   print CGI::end_form();
  605 
  606   return "";
  607 }
  608 
  609 ################################################################################
  610 # extract particular params and put them in a hash (values are ARRAYREFs!)
  611 ################################################################################
  612 
  613 sub getActionParams {
  614   my ($self, $actionID) = @_;
  615   my $r = $self->{r};
  616 
  617   my %actionParams;
  618   foreach my $param ($r->param) {
  619     next unless $param =~ m/^action\.$actionID\./;
  620     $actionParams{$param} = [ $r->param($param) ];
  621   }
  622   return %actionParams;
  623 }
  624 
  625 sub getTableParams {
  626   my ($self) = @_;
  627   my $r = $self->{r};
  628 
  629   my %tableParams;
  630   foreach my $param ($r->param) {
  631     next unless $param =~ m/^(?:set)\./;
  632     $tableParams{$param} = [ $r->param($param) ];
  633   }
  634   return %tableParams;
  635 }
  636 
  637 ################################################################################
  638 # actions and action triggers
  639 ################################################################################
  640 
  641 # filter, edit, cancelEdit, and saveEdit should stay with the display module and
  642 # not be real "actions". that way, all actions are shown in view mode and no
  643 # actions are shown in edit mode.
  644 
  645 sub filter_form {
  646   my ($self, $onChange, %actionParams) = @_;
  647   #return CGI::table({}, CGI::Tr({-valign=>"top"},
  648   # CGI::td({},
  649   return join("",
  650       "Show ",
  651       CGI::popup_menu(
  652         -name => "action.filter.scope",
  653         -values => [qw(all none selected match_ids visible unvisible)],
  654         -default => $actionParams{"action.filter.scope"}->[0] || "match_ids",
  655         -labels => {
  656           all => "all sets",
  657           none => "no sets",
  658           selected => "sets checked below",
  659           visible => "sets visible to students",
  660           unvisible => "sets hidden from students",
  661           match_ids => "sets with matching set IDs:",
  662         },
  663         -onchange => $onChange,
  664       ),
  665       " ",
  666       CGI::textfield(
  667         -name => "action.filter.set_ids",
  668         -value => $actionParams{"action.filter.set_ids"}->[0] || "",,
  669         -width => "50",
  670         -onchange => $onChange,
  671       ),
  672       " (separate multiple IDs with commas)",
  673       CGI::br(),
  674 #     "Open dates: ",
  675 #     CGI::popup_menu(
  676 #       -name => "action.filter.open_date",
  677 #       -values => [ keys %{ $self->{open_dates} } ],
  678 #       -default => $actionParams{"action.filter.open_date"}->[0] || "",
  679 #       -labels => { $self->menuLabels($self->{open_dates}) },
  680 #       -onchange => $onChange,
  681 #     ),
  682 #     " Due dates: ",
  683 #     CGI::popup_menu(
  684 #       -name => "action.filter.due_date",
  685 #       -values => [ keys %{ $self->{due_dates} } ],
  686 #       -default => $actionParams{"action.filter.due_date"}->[0] || "",
  687 #       -labels => { $self->menuLabels($self->{due_dates}) },
  688 #       -onchange => $onChange,
  689 #     ),
  690 #     " Answer dates: ",
  691 #     CGI::popup_menu(
  692 #       -name => "action.filter.answer_date",
  693 #       -values => [ keys %{ $self->{answer_dates} } ],
  694 #       -default => $actionParams{"action.filter.answer_date"}->[0] || "",
  695 #       -labels => { $self->menuLabels($self->{answer_dates}) },
  696 #       -onchange => $onChange,
  697 #     ),
  698 
  699   );
  700 }
  701 
  702 # this action handler modifies the "visibleUserIDs" field based on the contents
  703 # of the "action.filter.scope" parameter and the "selected_users"
  704 sub filter_handler {
  705   my ($self, $genericParams, $actionParams, $tableParams) = @_;
  706 
  707   my $r = $self->r ;
  708   my $db = $r->db;
  709 
  710   my $result;
  711 
  712   my $scope = $actionParams->{"action.filter.scope"}->[0];
  713   if ($scope eq "all") {
  714     $result = "showing all sets";
  715     $self->{visibleSetIDs} = $self->{allSetIDs};
  716   } elsif ($scope eq "none") {
  717     $result = "showing no sets";
  718     $self->{visibleSetIDs} = [];
  719   } elsif ($scope eq "selected") {
  720     $result = "showing selected sets";
  721     $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref
  722   } elsif ($scope eq "match_ids") {
  723     my @setIDs = split /\s*,\s*/, $actionParams->{"action.filter.set_ids"}->[0];
  724     $self->{visibleSetIDs} = \@setIDs;
  725   } elsif ($scope eq "match_open_date") {
  726     my $open_date = $actionParams->{"action.filter.open_date"}->[0];
  727     $self->{visibleSetIDs} = $self->{open_dates}->{$open_date}; # an arrayref
  728   } elsif ($scope eq "match_due_date") {
  729     my $due_date = $actionParams->{"action.filter.due_date"}->[0];
  730     $self->{visibleSetIDs} = $self->{due_date}->{$due_date}; # an arrayref
  731   } elsif ($scope eq "match_answer_date") {
  732     my $answer_date = $actionParams->{"action.filter.answer_date"}->[0];
  733     $self->{visibleSetIDs} = $self->{answer_dates}->{$answer_date}; # an arrayref
  734   } elsif ($scope eq "visible") {
  735     # DBFIXME do filtering in the database, please!
  736     my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}});
  737     my @visibleSetIDs = map { $_->visible ? $_->set_id : ""} @setRecords;
  738     $self->{visibleSetIDs} = \@visibleSetIDs;
  739   } elsif ($scope eq "unvisible") {
  740     # DBFIXME do filtering in the database, please!
  741     my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}});
  742     my @unvisibleSetIDs = map { (not $_->visible) ? $_->set_id : ""} @setRecords;
  743     $self->{visibleSetIDs} = \@unvisibleSetIDs;
  744   }
  745 
  746   return $result;
  747 }
  748 
  749 sub sort_form {
  750   my ($self, $onChange, %actionParams) = @_;
  751   return join ("",
  752     "Primary sort: ",
  753     CGI::popup_menu(
  754       -name => "action.sort.primary",
  755       -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date visible)],
  756       -default => $actionParams{"action.sort.primary"}->[0] || "due_date",
  757       -labels => {
  758         set_id    => "Set Name",
  759         set_header  => "Set Header",
  760         hardcopy_header => "Hardcopy Header",
  761         open_date => "Open Date",
  762         due_date  => "Due Date",
  763         answer_date => "Answer Date",
  764         visible => "Visibility",
  765       },
  766       -onchange => $onChange,
  767     ),
  768     " Secondary sort: ",
  769     CGI::popup_menu(
  770       -name => "action.sort.secondary",
  771       -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date visible)],
  772       -default => $actionParams{"action.sort.secondary"}->[0] || "open_date",
  773       -labels => {
  774         set_id    => "Set Name",
  775         set_header  => "Set Header",
  776         hardcopy_header => "Hardcopy Header",
  777         open_date => "Open Date",
  778         due_date  => "Due Date",
  779         answer_date => "Answer Date",
  780         visible => "Visibility",
  781       },
  782       -onchange => $onChange,
  783     ),
  784     ".",
  785   );
  786 }
  787 
  788 sub sort_handler {
  789   my ($self, $genericParams, $actionParams, $tableParams) = @_;
  790 
  791   my $primary = $actionParams->{"action.sort.primary"}->[0];
  792   my $secondary = $actionParams->{"action.sort.secondary"}->[0];
  793 
  794   $self->{primarySortField} = $primary;
  795   $self->{secondarySortField} = $secondary;
  796 
  797   my %names = (
  798     set_id    => "Set Name",
  799     set_header  => "Set Header",
  800     hardcopy_header => "Hardcopy Header",
  801     open_date => "Open Date",
  802     due_date  => "Due Date",
  803     answer_date => "Answer Date",
  804     visible => "Visibility",
  805   );
  806 
  807   return "sort by $names{$primary} and then by $names{$secondary}.";
  808 }
  809 
  810 
  811 sub edit_form {
  812   my ($self, $onChange, %actionParams) = @_;
  813 
  814   return join("",
  815     "Edit ",
  816     CGI::popup_menu(
  817       -name => "action.edit.scope",
  818       -values => [qw(all visible selected)],
  819       -default => $actionParams{"action.edit.scope"}->[0] || "selected",
  820       -labels => {
  821         all => "all sets",
  822         visible => "visible sets",
  823         selected => "selected sets",
  824       },
  825       -onchange => $onChange,
  826     ),
  827   );
  828 }
  829 
  830 sub edit_handler {
  831   my ($self, $genericParams, $actionParams, $tableParams) = @_;
  832 
  833   my $result;
  834 
  835   my $scope = $actionParams->{"action.edit.scope"}->[0];
  836   if ($scope eq "all") {
  837     $result = "editing all sets";
  838     $self->{visibleSetIDs} = $self->{allSetIDs};
  839   } elsif ($scope eq "visible") {
  840     $result = "editing visible sets";
  841     # leave visibleUserIDs alone
  842   } elsif ($scope eq "selected") {
  843     $result = "editing selected sets";
  844     $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref
  845   }
  846   $self->{editMode} = 1;
  847 
  848   return $result;
  849 }
  850 
  851 sub publish_form {
  852   my ($self, $onChange, %actionParams) = @_;
  853 
  854   return join ("",
  855     "Make ",
  856     CGI::popup_menu(
  857       -name => "action.publish.scope",
  858       -values => [ qw(none all selected) ],
  859       -default => $actionParams{"action.publish.scope"}->[0] || "selected",
  860       -labels => {
  861         none => "",
  862         all => "all sets",
  863 #       visible => "visible sets",
  864         selected => "selected sets",
  865       },
  866       -onchange => $onChange,
  867     ),
  868     CGI::popup_menu(
  869       -name => "action.publish.value",
  870       -values => [ 0, 1 ],
  871       -default => $actionParams{"action.publish.value"}->[0] || "1",
  872       -labels => {
  873         0 => "hidden",
  874         1 => "visible",
  875       },
  876       -onchange => $onChange,
  877     ),
  878     " for students.",
  879   );
  880 }
  881 
  882 sub publish_handler {
  883   my ($self, $genericParams, $actionParams, $tableParams) = @_;
  884 
  885   my $r = $self->r;
  886   my $db = $r->db;
  887 
  888   my $result = "";
  889 
  890   my $scope = $actionParams->{"action.publish.scope"}->[0];
  891   my $value = $actionParams->{"action.publish.value"}->[0];
  892 
  893   my $verb = $value ? "made visible for" : "hidden from";
  894 
  895   my @setIDs;
  896 
  897   if ($scope eq "none") { # FIXME: double negative "Make no sets hidden" might make professor expect all sets to be made visible.
  898     @setIDs = ();
  899     $result = CGI::div({class=>"ResultsWithError"},"No change made to any set.");
  900   } elsif ($scope eq "all") {
  901     @setIDs = @{ $self->{allSetIDs} };
  902     $result = CGI::div({class=>"ResultsWithoutError"},"All sets $verb all students.");
  903   } elsif ($scope eq "visible") {
  904     @setIDs = @{ $self->{visibleSetIDs} };
  905     $result = CGI::div({class=>"ResultsWithoutError"},"All visible sets $verb all students.");
  906   } elsif ($scope eq "selected") {
  907     @setIDs = @{ $genericParams->{selected_sets} };
  908     $result = CGI::div({class=>"ResultsWithoutError"},"All selected sets $verb all students.");
  909   }
  910 
  911   # can we use UPDATE here, instead of fetch/change/store?
  912   my @sets = $db->getGlobalSets(@setIDs);
  913 
  914   map { $_->visible("$value") if $_; $db->putGlobalSet($_); } @sets;
  915 
  916   return $result
  917 
  918 }
  919 sub enable_reduced_scoring_form {
  920   my ($self, $onChange, %actionParams) = @_;
  921 
  922   return join ("",
  923     "Make ",
  924     CGI::popup_menu(
  925       -name => "action.enable_reduced_scoring.scope",
  926       -values => [ qw(none all selected) ],
  927       -default => $actionParams{"action.enable_reduced_scoring.scope"}->[0] || "selected",
  928       -labels => {
  929         none => "",
  930         all => "all sets",
  931 #       visible => "visible sets",
  932         selected => "selected sets",
  933       },
  934       -onchange => $onChange,
  935     ),
  936     CGI::popup_menu(
  937       -name => "action.enable_reduced_scoring.value",
  938       -values => [ 0, 1 ],
  939       -default => $actionParams{"action.enable_reduced_scoring.value"}->[0] || "1",
  940       -labels => {
  941         0 => "disable",
  942         1 => "enable",
  943       },
  944       -onchange => $onChange,
  945     ),
  946     " reduced sccoring.",
  947   );
  948 }
  949 
  950 sub enable_reduced_scoring_handler {
  951   my ($self, $genericParams, $actionParams, $tableParams) = @_;
  952 
  953   my $r = $self->r;
  954   my $db = $r->db;
  955 
  956   my $result = "";
  957 
  958   my $scope = $actionParams->{"action.enable_reduced_scoring.scope"}->[0];
  959   my $value = $actionParams->{"action.enable_reduced_scoring.value"}->[0];
  960 
  961   my $verb = $value ? "enabled" : "disabled";
  962 
  963   my @setIDs;
  964 
  965   if ($scope eq "none") { # FIXME: double negative "Make no sets hidden" might make professor expect all sets to be made visible.
  966     @setIDs = ();
  967     $result =  CGI::div({class=>"ResultsWithError"}, "No change made to any set.");
  968   } elsif ($scope eq "all") {
  969     @setIDs = @{ $self->{allSetIDs} };
  970     $result = CGI::div({class=>"ResultsWithoutError"},"Reduced Credit $verb for all sets.");
  971   } elsif ($scope eq "visible") {
  972     @setIDs = @{ $self->{visibleSetIDs} };
  973     $result = CGI::div({class=>"ResultsWithoutError"},"Reduced Credit $verb for visable sets.");
  974   } elsif ($scope eq "selected") {
  975     @setIDs = @{ $genericParams->{selected_sets} };
  976     $result = CGI::div({class=>"ResultsWithoutError"},"Reduced Credit $verb for selected sets.");
  977   }
  978 
  979   # can we use UPDATE here, instead of fetch/change/store?
  980   my @sets = $db->getGlobalSets(@setIDs);
  981 
  982   map { $_->enable_reduced_scoring("$value") if $_; $db->putGlobalSet($_); } @sets;
  983 
  984   return $result
  985 
  986 }
  987 
  988 sub score_form {
  989   my ($self, $onChange, %actionParams) = @_;
  990 
  991   return join ("",
  992     "Score ",
  993     CGI::popup_menu(
  994       -name => "action.score.scope",
  995       -values => [qw(none all selected)],
  996       -default => $actionParams{"action.score.scope"}->[0] || "none",
  997       -labels => {
  998         none => "no sets.",
  999         all => "all sets.",
 1000         selected => "selected sets.",
 1001       },
 1002       -onchange => $onChange,
 1003     ),
 1004   );
 1005 
 1006 
 1007 
 1008 }
 1009 
 1010 sub score_handler {
 1011   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1012 
 1013   my $r      = $self->r;
 1014   my $urlpath = $r->urlpath;
 1015   my $courseName = $urlpath->arg("courseID");
 1016 
 1017   my $scope = $actionParams->{"action.score.scope"}->[0];
 1018   my @setsToScore;
 1019 
 1020   if ($scope eq "none") {
 1021     @setsToScore = ();
 1022     return "No sets selected for scoring.";
 1023   } elsif ($scope eq "all") {
 1024     @setsToScore = @{ $self->{allSetIDs} };
 1025   } elsif ($scope eq "visible") {
 1026     @setsToScore = @{ $self->{visibleSetIDs} };
 1027   } elsif ($scope eq "selected") {
 1028     @setsToScore = @{ $genericParams->{selected_sets} };
 1029   }
 1030 
 1031   my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring',$r, courseID=>$courseName),
 1032           params=>{
 1033             scoreSelected=>"Score Selected",
 1034             selectedSet=>\@setsToScore,
 1035 #           recordSingleSetScores=>''
 1036           }
 1037   );
 1038 
 1039 
 1040   return $uri;
 1041 }
 1042 
 1043 
 1044 sub delete_form {
 1045   my ($self, $onChange, %actionParams) = @_;
 1046 
 1047   return join("",
 1048     CGI::div({class=>"ResultsWithError"},
 1049       "Delete ",
 1050       CGI::popup_menu(
 1051         -name => "action.delete.scope",
 1052         -values => [qw(none selected)],
 1053         -default => "none", #  don't make it easy to delete # $actionParams{"action.delete.scope"}->[0] || "none",
 1054         -labels => {
 1055           none => "no sets.",
 1056           #visible => "visible sets.",
 1057           selected => "selected sets.",
 1058         },
 1059         -onchange => $onChange,
 1060       ),
 1061       CGI::em(" Deletion destroys all set-related data and is not undoable!"),
 1062     )
 1063   );
 1064 }
 1065 
 1066 sub delete_handler {
 1067   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1068 
 1069   my $r      = $self->r;
 1070   my $db     = $r->db;
 1071 
 1072   my $scope = $actionParams->{"action.delete.scope"}->[0];
 1073 
 1074 
 1075   my @setIDsToDelete = ();
 1076 
 1077   if ($scope eq "selected") {
 1078     @setIDsToDelete = @{ $self->{selectedSetIDs} };
 1079   }
 1080 
 1081   my %allSetIDs = map { $_ => 1 } @{ $self->{allSetIDs} };
 1082   my %visibleSetIDs = map { $_ => 1 } @{ $self->{visibleSetIDs} };
 1083   my %selectedSetIDs = map { $_ => 1 } @{ $self->{selectedSetIDs} };
 1084 
 1085   foreach my $setID (@setIDsToDelete) {
 1086     delete $allSetIDs{$setID};
 1087     delete $visibleSetIDs{$setID};
 1088     delete $selectedSetIDs{$setID};
 1089     $db->deleteGlobalSet($setID);
 1090   }
 1091 
 1092   $self->{allSetIDs} = [ keys %allSetIDs ];
 1093   $self->{visibleSetIDs} = [ keys %visibleSetIDs ];
 1094   $self->{selectedSetIDs} = [ keys %selectedSetIDs ];
 1095 
 1096   my $num = @setIDsToDelete;
 1097    return CGI::div({class=>"ResultsWithoutError"},  "deleted $num set" .
 1098                                              ($num == 1 ? "" : "s")
 1099   );
 1100 }
 1101 
 1102 sub create_form {
 1103   my ($self, $onChange, %actionParams) = @_;
 1104 
 1105   my $r      = $self->r;
 1106 
 1107   return "Create a new set named: ",
 1108     CGI::textfield(
 1109       -name => "action.create.name",
 1110       -value => $actionParams{"action.create.name"}->[0] || "",
 1111       -width => "50",
 1112       -onchange => $onChange,
 1113     ),
 1114     " as ",
 1115     CGI::popup_menu(
 1116       -name => "action.create.type",
 1117       -values => [qw(empty copy)],
 1118       -default => $actionParams{"action.create.type"}->[0] || "empty",
 1119       -labels => {
 1120         empty => "a new empty set.",
 1121         copy => "a duplicate of the first selected set.",
 1122       },
 1123       -onchange => $onChange,
 1124     );
 1125 
 1126 }
 1127 
 1128 sub create_handler {
 1129   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1130 
 1131   my $r      = $self->r;
 1132   my $db     = $r->db;
 1133 
 1134   my $newSetID = $actionParams->{"action.create.name"}->[0];
 1135   return CGI::div({class => "ResultsWithError"}, "Failed to create new set: no set name specified!") unless $newSetID =~ /\S/;
 1136   return CGI::div({class => "ResultsWithError"}, "Set $newSetID exists.  No set created") if $db->existsGlobalSet($newSetID);
 1137   my $newSetRecord = $db->newGlobalSet;
 1138   my $oldSetID = $self->{selectedSetIDs}->[0];
 1139 
 1140   my $type = $actionParams->{"action.create.type"}->[0];
 1141   # It's convenient to set the open date one week from now so that it is
 1142   # not accidentally available to students.  We set the due and answer date
 1143   # to be two weeks from now.
 1144 
 1145 
 1146   if ($type eq "empty") {
 1147     $newSetRecord->set_id($newSetID);
 1148     $newSetRecord->set_header("defaultHeader");
 1149     $newSetRecord->hardcopy_header("defaultHeader");
 1150     $newSetRecord->open_date(time + ONE_WEEK());
 1151     $newSetRecord->due_date(time + 2*ONE_WEEK() );
 1152     $newSetRecord->answer_date(time + 2*ONE_WEEK() );
 1153     $newSetRecord->visible(DEFAULT_VISIBILITY_STATE()); # don't want students to see an empty set
 1154     $newSetRecord->enable_reduced_scoring(DEFAULT_ENABLED_REDUCED_SCORING_STATE());
 1155     $db->addGlobalSet($newSetRecord);
 1156   } elsif ($type eq "copy") {
 1157     return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set selected for duplication!") unless $oldSetID =~ /\S/;
 1158     $newSetRecord = $db->getGlobalSet($oldSetID);
 1159     $newSetRecord->set_id($newSetID);
 1160     $db->addGlobalSet($newSetRecord);
 1161 
 1162     # take all the problems from the old set and make them part of the new set
 1163     foreach ($db->getAllGlobalProblems($oldSetID)) {
 1164       $_->set_id($newSetID);
 1165       $db->addGlobalProblem($_);
 1166     }
 1167 
 1168     # also copy any set_location restrictions and set-level proctor
 1169     #    information
 1170     foreach ($db->getAllGlobalSetLocations($oldSetID)) {
 1171       $_->set_id($newSetID);
 1172       $db->addGlobalSetLocation($_);
 1173     }
 1174     if ( $newSetRecord->restricted_login_proctor eq 'Yes' ) {
 1175       my $procUser = $db->getUser("set_id:$oldSetID");
 1176       $procUser->user_id("set_id:$newSetID");
 1177       eval { $db->addUser( $procUser ) };
 1178       if ( ! $@ ) {
 1179         my $procPerm = $db->getPermissionLevel("set_id:$oldSetID");
 1180         $procPerm->user_id("set_id:$newSetID");
 1181         $db->addPermissionLevel($procPerm);
 1182         my $procPass = $db->getPassword("set_id:$oldSetID");
 1183         $procPass->user_id("set_id:$newSetID");
 1184         $db->addPassword($procPass);
 1185       }
 1186     }
 1187   }
 1188     #  Assign set to current active user
 1189      my $userName = $r->param('user'); # FIXME possible security risk
 1190      $self->assignSetToUser($userName, $newSetRecord); # cures weird date error when no-one assigned to set
 1191    $self->addgoodmessage("Set $newSetID was assigned to $userName."); # not currently used
 1192 
 1193   push @{ $self->{visibleSetIDs} }, $newSetID;
 1194   push @{ $self->{allSetIds} }, $newSetID;
 1195 
 1196   return CGI::div({class => "ResultsWithError"}, "Failed to create new set: $@") if $@;
 1197 
 1198    return CGI::div({class=>"ResultsWithoutError"},"Successfully created new set $newSetID" );
 1199 
 1200 }
 1201 
 1202 sub import_form {
 1203   my ($self, $onChange, %actionParams) = @_;
 1204 
 1205   my $r = $self->r;
 1206   my $authz = $r->authz;
 1207   my $user = $r->param('user');
 1208 
 1209   # this will make the popup menu alternate between a single selection and a multiple selection menu
 1210   # Note: search by name is required since document.problemsetlist.action.import.number is not seen as
 1211   # a valid reference to the object named 'action.import.number'
 1212   my $importScript = join (" ",
 1213         "var number = document.getElementsByName('action.import.number')[0].value;",
 1214         "document.getElementsByName('action.import.source')[0].size = number;",
 1215         "document.getElementsByName('action.import.source')[0].multiple = (number > 1 ? true : false);",
 1216         "document.getElementsByName('action.import.name')[0].value = (number > 1 ? '(taken from filenames)' : '');",
 1217       );
 1218 
 1219   return join(" ",
 1220     "Import ",
 1221     CGI::popup_menu(
 1222       -name => "action.import.number",
 1223       -values => [ 1, 8 ],
 1224       -default => $actionParams{"action.import.number"}->[0] || "1",
 1225       -labels => {
 1226         1 => "a single set",
 1227         8 => "multiple sets",
 1228       },
 1229       -onchange => "$onChange;$importScript",
 1230     ),
 1231     " from ", # set definition file(s) ",
 1232     CGI::popup_menu(
 1233       -name => "action.import.source",
 1234       -values => [ "", $self->getDefList() ],
 1235       -labels => { "" => "the following file(s)" },
 1236       -default => $actionParams{"action.import.source"}->[0] || "",
 1237       -size => $actionParams{"action.import.number"}->[0] || "1",
 1238       -onchange => $onChange,
 1239     ),
 1240     " with set name(s): ",
 1241     CGI::textfield(
 1242       -name => "action.import.name",
 1243       -value => $actionParams{"action.import.name"}->[0] || "",
 1244       -width => "50",
 1245       -onchange => $onChange,
 1246     ),
 1247     ($authz->hasPermissions($user, "assign_problem_sets"))
 1248       ?
 1249       "assigning this set to " .
 1250       CGI::popup_menu(
 1251         -name => "action.import.assign",
 1252         -value => [qw(user all)],
 1253         -default => $actionParams{"action.import.assign"}->[0] || "user",
 1254         -labels => {
 1255           all => "all current users.",
 1256           user => "only $user.",
 1257         },
 1258         -onchange => $onChange,
 1259       )
 1260       :
 1261       ""  #user does not have permissions to assign problem sets
 1262   );
 1263 }
 1264 
 1265 sub import_handler {
 1266   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1267 
 1268   my @fileNames = @{ $actionParams->{"action.import.source"} };
 1269   my $newSetName = $actionParams->{"action.import.name"}->[0];
 1270   $newSetName = "" if $actionParams->{"action.import.number"}->[0] > 1; # cannot assign set names to multiple imports
 1271   my $assign = $actionParams->{"action.import.assign"}->[0];
 1272 
 1273   my ($added, $skipped) = $self->importSetsFromDef($newSetName, $assign, @fileNames);
 1274 
 1275   # make new sets visible... do we really want to do this? probably.
 1276   push @{ $self->{visibleSetIDs} }, @$added;
 1277   push @{ $self->{allSetIDs} }, @$added;
 1278 
 1279   my $numAdded = @$added;
 1280   my $numSkipped = @$skipped;
 1281 
 1282    return CGI::div(
 1283     {class=>"ResultsWithoutError"},
 1284     $numAdded . " set" . ($numAdded == 1 ? "" : "s") . " added, "
 1285     . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped"
 1286     . " (" . join (", ", @$skipped) . ") "
 1287   );
 1288 }
 1289 
 1290 sub export_form {
 1291   my ($self, $onChange, %actionParams) = @_;
 1292 
 1293   return join("",
 1294     "Export ",
 1295     CGI::popup_menu(
 1296       -name => "action.export.scope",
 1297       -values => [qw(all visible selected)],
 1298       -default => $actionParams{"action.export.scope"}->[0] || "visible",
 1299       -labels => {
 1300         all => "all sets",
 1301         visible => "visible sets",
 1302         selected => "selected sets",
 1303       },
 1304       -onchange => $onChange,
 1305     ),
 1306   );
 1307 }
 1308 
 1309 # this does not actually export any files, rather it sends us to a new page in order to export the files
 1310 sub export_handler {
 1311   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1312 
 1313   my $result;
 1314 
 1315   my $scope = $actionParams->{"action.export.scope"}->[0];
 1316   if ($scope eq "all") {
 1317     $result = "exporting all sets";
 1318     $self->{selectedSetIDs} = $self->{visibleSetIDs} = $self->{allSetIDs};
 1319 
 1320   } elsif ($scope eq "visible") {
 1321     $result = "exporting visible sets";
 1322     $self->{selectedSetIDs} = $self->{visibleSetIDs};
 1323   } elsif ($scope eq "selected") {
 1324     $result = "exporting selected sets";
 1325     $self->{selectedSetIDs} = $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref
 1326   }
 1327   $self->{exportMode} = 1;
 1328 
 1329   return   CGI::div({class=>"ResultsWithoutError"},  $result);
 1330 }
 1331 
 1332 sub cancelExport_form {
 1333   my ($self, $onChange, %actionParams) = @_;
 1334   return "Abandon export";
 1335 }
 1336 
 1337 sub cancelExport_handler {
 1338   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1339   my $r      = $self->r;
 1340 
 1341   #$self->{selectedSetIDs) = $self->{visibleSetIDs};
 1342     # only do the above if we arrived here via "edit selected users"
 1343   if (defined $r->param("prev_visible_sets")) {
 1344     $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ];
 1345   } elsif (defined $r->param("no_prev_visible_sets")) {
 1346     $self->{visibleSetIDs} = [];
 1347   } else {
 1348     # leave it alone
 1349   }
 1350   $self->{exportMode} = 0;
 1351 
 1352   return CGI::div({class=>"ResultsWithError"},  "export abandoned");
 1353 }
 1354 
 1355 sub saveExport_form {
 1356   my ($self, $onChange, %actionParams) = @_;
 1357   return "Export selected sets.";
 1358 }
 1359 
 1360 sub saveExport_handler {
 1361   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1362   my $r           = $self->r;
 1363   my $db          = $r->db;
 1364 
 1365   my @setIDsToExport = @{ $self->{selectedSetIDs} };
 1366 
 1367   my %filenames = map { $_ => (@{ $tableParams->{"set.$_"} }[0] || $_) } @setIDsToExport;
 1368 
 1369   my ($exported, $skipped, $reason) = $self->exportSetsToDef(%filenames);
 1370 
 1371   if (defined $r->param("prev_visible_sets")) {
 1372     $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ];
 1373   } elsif (defined $r->param("no_prev_visble_sets")) {
 1374     $self->{visibleSetIDs} = [];
 1375   } else {
 1376     # leave it alone
 1377   }
 1378 
 1379   $self->{exportMode} = 0;
 1380 
 1381   my $numExported = @$exported;
 1382   my $numSkipped = @$skipped;
 1383   my $resultFont = ($numSkipped)? "ResultsWithError" : "ResultsWithoutError";
 1384 
 1385   my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason;
 1386 
 1387   return  CGI::div( {class=>$resultFont},
 1388       $numExported . " set" . ($numExported == 1 ? "" : "s") . " exported, "
 1389     . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped."
 1390     . (($numSkipped) ? CGI::ul(CGI::li(\@reasons)) : "")
 1391     );
 1392 
 1393 }
 1394 
 1395 sub cancelEdit_form {
 1396   my ($self, $onChange, %actionParams) = @_;
 1397   return "Abandon changes";
 1398 }
 1399 
 1400 sub cancelEdit_handler {
 1401   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1402   my $r      = $self->r;
 1403 
 1404   #$self->{selectedSetIDs) = $self->{visibleSetIDs};
 1405     # only do the above if we arrived here via "edit selected users"
 1406   if (defined $r->param("prev_visible_sets")) {
 1407     $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ];
 1408   } elsif (defined $r->param("no_prev_visible_sets")) {
 1409     $self->{visibleSetIDs} = [];
 1410   } else {
 1411     # leave it alone
 1412   }
 1413   $self->{editMode} = 0;
 1414 
 1415   return CGI::div({class=>"ResultsWithError"}, "changes abandoned");
 1416 }
 1417 
 1418 sub saveEdit_form {
 1419   my ($self, $onChange, %actionParams) = @_;
 1420   return "Save changes";
 1421 }
 1422 
 1423 sub saveEdit_handler {
 1424   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1425   my $r           = $self->r;
 1426   my $db          = $r->db;
 1427 
 1428   my @visibleSetIDs = @{ $self->{visibleSetIDs} };
 1429   foreach my $setID (@visibleSetIDs) {
 1430     my $Set = $db->getGlobalSet($setID); # checked
 1431     # FIXME: we may not want to die on bad sets, they're not as bad as bad users
 1432     die "record for visible set $setID not found" unless $Set;
 1433 
 1434     foreach my $field ($Set->NONKEYFIELDS()) {
 1435       my $param = "set.${setID}.${field}";
 1436       if (defined $tableParams->{$param}->[0]) {
 1437         if ($field =~ /_date/) {
 1438           $Set->$field($self->parseDateTime($tableParams->{$param}->[0]));
 1439         } else {
 1440           $Set->$field($tableParams->{$param}->[0]);
 1441         }
 1442       }
 1443     }
 1444 
 1445     # make sure the dates are not more than 10 years in the future
 1446     my $curr_time = time;
 1447     my $seconds_per_year = 31_556_926;
 1448     my $cutoff = $curr_time + $seconds_per_year*10;
 1449     return CGI::div({class=>'ResultsWithError'}, "Error: open date cannot be more than 10 years from now in set $setID")
 1450       if $Set->open_date > $cutoff;
 1451     return CGI::div({class=>'ResultsWithError'}, "Error: due date cannot be more than 10 years from now in set $setID")
 1452       if $Set->due_date > $cutoff;
 1453     return CGI::div({class=>'ResultsWithError'}, "Error: answer date cannot be more than 10 years from now in set $setID")
 1454       if $Set->answer_date > $cutoff;
 1455 
 1456     # Check that the open, due and answer dates are in increasing order.
 1457     # Bail if this is not correct.
 1458     if ($Set->open_date > $Set->due_date)  {
 1459       return CGI::div({class=>'ResultsWithError'}, "Error: Due date must come after open date in set $setID");
 1460     }
 1461     if ($Set->due_date > $Set->answer_date) {
 1462       return CGI::div({class=>'ResultsWithError'}, "Error: Answer date must come after due date in set $setID");
 1463     }
 1464 
 1465     $db->putGlobalSet($Set);
 1466   }
 1467 
 1468   if (defined $r->param("prev_visible_sets")) {
 1469     $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ];
 1470   } elsif (defined $r->param("no_prev_visble_sets")) {
 1471     $self->{visibleSetIDs} = [];
 1472   } else {
 1473     # leave it alone
 1474   }
 1475 
 1476   $self->{editMode} = 0;
 1477 
 1478   return CGI::div({class=>"ResultsWithError"}, "changes saved" );
 1479 }
 1480 
 1481 sub duplicate_form {
 1482   my ($self, $onChange, %actionParams) = @_;
 1483 
 1484   my $r = $self->r;
 1485   my @visible_sets = $r->param('visible_sets');
 1486 
 1487   return "" unless @visible_sets == 1;
 1488 
 1489   return join ("",
 1490     "Duplicate this set and name it: ",
 1491     CGI::textfield(
 1492       -name => "action.duplicate.name",
 1493       -value => $actionParams{"action.duplicate.name"}->[0] || "",
 1494       -width => "50",
 1495       -onchange => $onChange,
 1496     ),
 1497   );
 1498 }
 1499 
 1500 sub duplicate_handler {
 1501   my ($self, $genericParams, $actionParams, $tableParams) = @_;
 1502 
 1503   my $r = $self->r;
 1504   my $db = $r->db;
 1505 
 1506   my $oldSetID = $self->{selectedSetIDs}->[0];
 1507   return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set selected for duplication!") unless defined($oldSetID) and $oldSetID =~ /\S/;
 1508   my $newSetID = $actionParams->{"action.duplicate.name"}->[0];
 1509   return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: no set name specified!") unless $newSetID =~ /\S/;
 1510   # DBFIXME checking for existence -- don't need to fetch
 1511   return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: set $newSetID already exists!") if defined $db->getGlobalSet($newSetID);
 1512 
 1513   my $newSet = $db->getGlobalSet($oldSetID);
 1514   $newSet->set_id($newSetID);
 1515   eval {$db->addGlobalSet($newSet)};
 1516 
 1517   # take all the problems from the old set and make them part of the new set
 1518   foreach ($db->getAllGlobalProblems($oldSetID)) {
 1519     $_->set_id($newSetID);
 1520     $db->addGlobalProblem($_);
 1521   }
 1522 
 1523   push @{ $self->{visibleSetIDs} }, $newSetID;
 1524 
 1525   return CGI::div({class => "ResultsWithError"}, "Failed to duplicate set: $@") if $@;
 1526 
 1527   return "SUCCESS";
 1528 }
 1529 
 1530 ################################################################################
 1531 # sorts
 1532 ################################################################################
 1533 
 1534 sub bySetID         { $a->set_id         cmp $b->set_id         }
 1535 
 1536 # I can't figure out why these are useful
 1537 
 1538 # sub bySetHeader     { $a->set_header     cmp $b->set_header     }
 1539 # sub byHardcopyHeader { $a->hardcopy_header cmp $b->hardcopy_header }
 1540 #FIXME  eventually we may be able to remove these checks, if we can trust
 1541 # that the dates are always defined
 1542 # dates which are the empty string '' or undefined  are treated as 0
 1543 sub byOpenDate      { my $result = eval{( $a->open_date || 0 )      <=> ( $b->open_date || 0 ) };
 1544                       return $result unless $@;
 1545                       warn "Open date not correctly defined.";
 1546                       return 0;
 1547 }
 1548 sub byDueDate       { my $result = eval{( $a->due_date || 0 )     <=> ( $b->due_date || 0 )   };
 1549                       return $result unless $@;
 1550                       warn "Due date not correctly defined.";
 1551                       return 0;
 1552 }
 1553 sub byAnswerDate    { my $result = eval{( $a->answer_date || 0)    <=> ( $b->answer_date || 0 )  };
 1554                       return $result unless $@;
 1555                       warn "Answer date not correctly defined.";
 1556                       return 0;
 1557 }
 1558 sub byVisible     { my $result = eval{$a->visible      cmp $b->visible   };
 1559                       return $result unless $@;
 1560                       warn "Visibility status not correctly defined.";
 1561                       return 0;
 1562 }
 1563 
 1564 sub byOpenDue       { &byOpenDate || &byDueDate }
 1565 
 1566 ################################################################################
 1567 # utilities
 1568 ################################################################################
 1569 
 1570 # generate labels for open_date/due_date/answer_date popup menus
 1571 sub menuLabels {
 1572   my ($self, $hashRef) = @_;
 1573   my %hash = %$hashRef;
 1574 
 1575   my %result;
 1576   foreach my $key (keys %hash) {
 1577     my $count = @{ $hash{$key} };
 1578     my $displayKey = $self->formatDateTime($key) || "<none>";
 1579     $result{$key} = "$displayKey ($count sets)";
 1580   }
 1581   return %result;
 1582 }
 1583 
 1584 sub importSetsFromDef {
 1585   my ($self, $newSetName, $assign, @setDefFiles) = @_;
 1586   my $r     = $self->r;
 1587   my $ce    = $r->ce;
 1588   my $db    = $r->db;
 1589   my $dir   = $ce->{courseDirs}->{templates};
 1590 
 1591   # if the user includes "following files" in a multiple selection
 1592   # it shows up here as "" which causes the importing to die
 1593   # so, we select on filenames containing non-whitespace
 1594   @setDefFiles = grep(/\S/, @setDefFiles);
 1595 
 1596   # FIXME: do we really want everything to fail on one bad file name?
 1597   foreach my $fileName (@setDefFiles) {
 1598     die "won't be able to read from file $dir/$fileName: does it exist? is it readable?"
 1599       unless -r "$dir/$fileName";
 1600   }
 1601 
 1602   my @allSetIDs = $db->listGlobalSets();
 1603   # FIXME: getGlobalSets takes a lot of time just for checking to see if a set already exists
 1604   #   this could be avoided by waiting until the call to addGlobalSet below
 1605   # and checking to see if the error message says that the set already exists
 1606   # but if the error message is ever changed the code here might be broken
 1607   # then again, one call to getGlobalSets and skipping unnecessary calls to addGlobalSet
 1608   # could be faster than no call to getGlobalSets and lots of unnecessary calls to addGlobalSet
 1609   # DBFIXME all we need here is set IDs, right? why fetch entire records?
 1610   my %allSets = map { $_->set_id => 1 if $_} $db->getGlobalSets(@allSetIDs); # checked
 1611 
 1612   my (@added, @skipped);
 1613 
 1614   foreach my $set_definition_file (@setDefFiles) {
 1615 
 1616     debug("$set_definition_file: reading set definition file");
 1617     # read data in set definition file
 1618     my ($setName, $paperHeaderFile, $screenHeaderFile, $openDate, $dueDate, $answerDate, $ra_problemData, $assignmentType, $attemptsPerVersion, $timeInterval, $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, $hideScore, $hideWork,$timeCap,$restrictIP,$restrictLoc,$relaxRestrictIP) = $self->readSetDef($set_definition_file);
 1619     my @problemList = @{$ra_problemData};
 1620 
 1621     # Use the original name if form doesn't specify a new one.
 1622     # The set acquires the new name specified by the form.  A blank
 1623     # entry on the form indicates that the imported set name will be used.
 1624     $setName = $newSetName if $newSetName;
 1625 
 1626     if ($allSets{$setName}) {
 1627       # this set already exists!!
 1628       push @skipped, $setName;
 1629       next;
 1630     } else {
 1631       push @added, $setName;
 1632     }
 1633 
 1634     debug("$set_definition_file: adding set");
 1635     # add the data to the set record
 1636     my $newSetRecord = $db->newGlobalSet;
 1637     $newSetRecord->set_id($setName);
 1638     $newSetRecord->set_header($screenHeaderFile);
 1639     $newSetRecord->hardcopy_header($paperHeaderFile);
 1640     $newSetRecord->open_date($openDate);
 1641     $newSetRecord->due_date($dueDate);
 1642     $newSetRecord->answer_date($answerDate);
 1643     $newSetRecord->visible(DEFAULT_VISIBILITY_STATE);
 1644     $newSetRecord->enable_reduced_scoring(DEFAULT_ENABLED_REDUCED_SCORING_STATE);
 1645 
 1646   # gateway/version data.  these should are all initialized to ''
 1647         #   by readSetDef, so for non-gateway/versioned sets they'll just
 1648         #   be stored as null
 1649     $newSetRecord->assignment_type($assignmentType);
 1650     $newSetRecord->attempts_per_version($attemptsPerVersion);
 1651     $newSetRecord->time_interval($timeInterval);
 1652     $newSetRecord->versions_per_interval($versionsPerInterval);
 1653     $newSetRecord->version_time_limit($versionTimeLimit);
 1654     $newSetRecord->problem_randorder($problemRandOrder);
 1655     $newSetRecord->problems_per_page($problemsPerPage);
 1656     $newSetRecord->hide_score($hideScore);
 1657     $newSetRecord->hide_work($hideWork);
 1658     $newSetRecord->time_limit_cap($timeCap);
 1659     $newSetRecord->restrict_ip($restrictIP);
 1660     $newSetRecord->relax_restrict_ip($relaxRestrictIP);
 1661 
 1662     #create the set
 1663     eval {$db->addGlobalSet($newSetRecord)};
 1664     die "addGlobalSet $setName in ProblemSetList:  $@" if $@;
 1665 
 1666     #do we need to add locations to the set_locations table?
 1667     if ( $restrictIP ne 'No' && $restrictLoc ) {
 1668       if ($db->existsLocation( $restrictLoc ) ) {
 1669         if ( ! $db->existsGlobalSetLocation($setName,$restrictLoc) ) {
 1670           my $newSetLocation = $db->newGlobalSetLocation;
 1671           $newSetLocation->set_id( $setName );
 1672           $newSetLocation->location_id( $restrictLoc );
 1673           eval {$db->addGlobalSetLocation($newSetLocation)};
 1674           warn("error adding set location $restrictLoc " .
 1675                "for set $setName: $@") if $@;
 1676         } else {
 1677           # this should never happen.
 1678           warn("input set location $restrictLoc" .
 1679                " already exists for set " .
 1680                "$setName.\n");
 1681         }
 1682       } else {
 1683         warn("restriction location $restrictLoc " .
 1684              "does not exist.  IP restrictions have " .
 1685              "been ignored.\n");
 1686         $newSetRecord->restrict_ip('No');
 1687         $newSetRecord->relax_restrict_ip('No');
 1688         eval { $db->putGlobalSet($newSetRecord) };
 1689         # we ignore error messages here; if the set
 1690         #    added without error before, we assume
 1691         #    (ha) that it will put without trouble
 1692       }
 1693     }
 1694 
 1695     debug("$set_definition_file: adding problems to database");
 1696     # add problems
 1697     my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1;
 1698     foreach my $rh_problem (@problemList) {
 1699       $self->addProblemToSet(
 1700         setName => $setName,
 1701         sourceFile => $rh_problem->{source_file},
 1702         problemID => $freeProblemID++,
 1703         value => $rh_problem->{value},
 1704         maxAttempts => $rh_problem->{max_attempts});
 1705     }
 1706 
 1707 
 1708     if ($assign eq "all") {
 1709       $self->assignSetToAllUsers($setName);
 1710     }
 1711     else {
 1712       my $userName = $r->param('user');
 1713       $self->assignSetToUser($userName, $newSetRecord); ## always assign set to instructor
 1714     }
 1715   }
 1716 
 1717   return \@added, \@skipped;
 1718 }
 1719 
 1720 sub readSetDef {
 1721   my ($self, $fileName) = @_;
 1722   my $templateDir   = $self->{ce}->{courseDirs}->{templates};
 1723   my $filePath      = "$templateDir/$fileName";
 1724   my $value_default = $self->{ce}->{problemDefaults}->{value};
 1725   my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts};
 1726 
 1727   my $setName = '';
 1728 
 1729   if ($fileName =~ m|^set([.\w-]+)\.def$|) {
 1730     $setName = $1;
 1731   } else {
 1732     $self->addbadmessage(
 1733         qq{The setDefinition file name must begin with   <CODE>set</CODE>},
 1734       qq{and must end with   <CODE>.def</CODE>  . Every thing in between becomes the name of the set. },
 1735       qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> },
 1736       qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. },
 1737       qq{The filename, $fileName, you entered is not legal\n }
 1738     );
 1739 
 1740   }
 1741 
 1742   my ($line, $name, $value, $attemptLimit, $continueFlag);
 1743   my $paperHeaderFile = '';
 1744   my $screenHeaderFile = '';
 1745   my ($dueDate, $openDate, $answerDate);
 1746   my @problemData;
 1747 
 1748 # added fields for gateway test/versioned set definitions:
 1749   my ( $assignmentType, $attemptsPerVersion, $timeInterval,
 1750        $versionsPerInterval, $versionTimeLimit, $problemRandOrder,
 1751        $problemsPerPage, $restrictLoc,
 1752        ) =
 1753      ('')x8;  # initialize these to ''
 1754   my ( $timeCap, $restrictIP, $relaxRestrictIP ) = ( 0, 'No', 'No');
 1755 # additional fields currently used only by gateways; later, the world?
 1756   my ( $hideScore, $hideWork, ) = ( 'N', 'N' );
 1757 
 1758   my %setInfo;
 1759   if ( open (SETFILENAME, "$filePath") )    {
 1760   #####################################################################
 1761   # Read and check set data
 1762   #####################################################################
 1763     while (<SETFILENAME>) {
 1764 
 1765       chomp($line = $_);
 1766       $line =~ s|(#.*)||;                              ## don't read past comments
 1767       unless ($line =~ /\S/) {next;}                   ## skip blank lines
 1768       $line =~ s|\s*$||;                               ## trim trailing spaces
 1769       $line =~ m|^\s*(\w+)\s*=\s*(.*)|;
 1770 
 1771       ######################
 1772       # sanity check entries
 1773       ######################
 1774       my $item = $1;
 1775       $item    = '' unless defined $item;
 1776       my $value = $2;
 1777       $value    = '' unless defined $value;
 1778 
 1779       if ($item eq 'setNumber') {
 1780         next;
 1781       } elsif ($item eq 'paperHeaderFile') {
 1782         $paperHeaderFile = $value;
 1783       } elsif ($item eq 'screenHeaderFile') {
 1784         $screenHeaderFile = $value;
 1785       } elsif ($item eq 'dueDate') {
 1786         $dueDate = $value;
 1787       } elsif ($item eq 'openDate') {
 1788         $openDate = $value;
 1789       } elsif ($item eq 'answerDate') {
 1790         $answerDate = $value;
 1791       } elsif ($item eq 'assignmentType') {
 1792         $assignmentType = $value;
 1793       } elsif ($item eq 'attemptsPerVersion') {
 1794         $attemptsPerVersion = $value;
 1795       } elsif ($item eq 'timeInterval') {
 1796         $timeInterval = $value;
 1797       } elsif ($item eq 'versionsPerInterval') {
 1798         $versionsPerInterval = $value;
 1799       } elsif ($item eq 'versionTimeLimit') {
 1800         $versionTimeLimit = $value;
 1801       } elsif ($item eq 'problemRandOrder') {
 1802         $problemRandOrder = $value;
 1803       } elsif ($item eq 'problemsPerPage') {
 1804         $problemsPerPage = $value;
 1805       } elsif ($item eq 'hideScore') {
 1806         $hideScore = ( $value ) ? $value : 'N';
 1807       } elsif ($item eq 'hideWork') {
 1808         $hideWork = ( $value ) ? $value : 'N';
 1809       } elsif ($item eq 'capTimeLimit') {
 1810         $timeCap = ( $value ) ? 1 : 0;
 1811       } elsif ($item eq 'restrictIP') {
 1812         $restrictIP = ( $value ) ? $value : 'No';
 1813       } elsif ($item eq 'restrictLocation' ) {
 1814         $restrictLoc = ( $value ) ? $value : '';
 1815       } elsif ( $item eq 'relaxRestrictIP' ) {
 1816         $relaxRestrictIP = ( $value ) ? $value : 'No';
 1817       } elsif ($item eq 'problemList') {
 1818         last;
 1819       } else {
 1820         warn "readSetDef error, can't read the line: ||$line||";
 1821       }
 1822     }
 1823 
 1824     #####################################################################
 1825     # Check and format dates
 1826     #####################################################################
 1827     my ($time1, $time2, $time3) = map {  $self->parseDateTime($_);  }    ($openDate, $dueDate, $answerDate);
 1828 
 1829     unless ($time1 <= $time2 and $time2 <= $time3) {
 1830       warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronological order.";
 1831     }
 1832 
 1833     # Check header file names
 1834     $paperHeaderFile =~ s/(.*?)\s*$/$1/;   #remove trailing white space
 1835     $screenHeaderFile =~ s/(.*?)\s*$/$1/;   #remove trailing white space
 1836 
 1837                 #####################################################################
 1838                 # Gateway/version variable cleanup: convert times into seconds
 1839     $timeInterval = WeBWorK::Utils::timeToSec( $timeInterval )
 1840         if ( $timeInterval );
 1841     $versionTimeLimit = WeBWorK::Utils::timeToSec($versionTimeLimit)
 1842         if ( $versionTimeLimit );
 1843 
 1844     # check that the values for hideWork and hideScore are valid
 1845     if ( $hideScore ne 'N' && $hideScore ne 'Y' &&
 1846          $hideScore ne 'BeforeAnswerDate' ) {
 1847       warn("The value $hideScore for the hideScore option " .
 1848            "is not valid; it will be replaced with 'N'.\n");
 1849       $hideScore = 'N';
 1850     }
 1851     if ( $hideWork ne 'N' && $hideWork ne 'Y' &&
 1852          $hideWork ne 'BeforeAnswerDate' ) {
 1853       warn("The value $hideWork for the hideWork option " .
 1854            "is not valid; it will be replaced with 'N'.\n");
 1855       $hideWork = 'N';
 1856     }
 1857     if ( $timeCap ne '0' && $timeCap ne '1' ) {
 1858       warn("The value $timeCap for the capTimeLimit option " .
 1859            "is not valid; it will be replaced with '0'.\n");
 1860       $timeCap = '0';
 1861     }
 1862     if ( $restrictIP ne 'No' && $restrictIP ne 'DenyFrom' &&
 1863          $restrictIP ne 'RestrictTo' ) {
 1864       warn("The value $restrictIP for the restrictIP " .
 1865            "option is not valid; it will be replaced " .
 1866            "with 'No'.\n");
 1867       $restrictIP = 'No';
 1868       $restrictLoc = '';
 1869       $relaxRestrictIP = 'No';
 1870     }
 1871     if ( $relaxRestrictIP ne 'No' &&
 1872          $relaxRestrictIP ne 'AfterAnswerDate' &&
 1873          $relaxRestrictIP ne 'AfterVersionAnswerDate' ) {
 1874       warn("The value $relaxRestrictIP for the " .
 1875            "relaxRestrictIP option is not valid; it will " .
 1876            "be replaced with 'No'.\n");
 1877       $relaxRestrictIP = 'No';
 1878     }
 1879     # to verify that restrictLoc is valid requires a database
 1880     #    call, so we defer that until we return to add the set
 1881 
 1882     #####################################################################
 1883     # Read and check list of problems for the set
 1884     #####################################################################
 1885     while(<SETFILENAME>) {
 1886       chomp($line=$_);
 1887       $line =~ s/(#.*)//;                             ## don't read past comments
 1888       unless ($line =~ /\S/) {next;}                  ## skip blank lines
 1889 
 1890       # commas are valid in filenames, so we have to handle commas
 1891       # using backslash escaping, so \X will be replaced with X
 1892       my @line = ();
 1893       my $curr = '';
 1894       for (my $i = 0; $i < length $line; $i++) {
 1895         my $c = substr($line,$i,1);
 1896         if ($c eq '\\') {
 1897           $curr .= substr($line,++$i,1);
 1898           } elsif ($c eq ',') {
 1899           push @line, $curr;
 1900           $curr = '';
 1901         } else {
 1902           $curr .= $c;
 1903         }
 1904       }
 1905       ## anything left?
 1906       push(@line, $curr) if ( $curr );
 1907 
 1908       ($name, $value, $attemptLimit, $continueFlag) = @line;
 1909       #####################
 1910       #  clean up problem values
 1911       ###########################
 1912       $name =~ s/\s*//g;
 1913       $value = "" unless defined($value);
 1914       $value =~ s/[^\d\.]*//g;
 1915       unless ($value =~ /\d+/) {$value = $value_default;}
 1916       $attemptLimit = "" unless defined($attemptLimit);
 1917       $attemptLimit =~ s/[^\d-]*//g;
 1918       unless ($attemptLimit =~ /\d+/) {$attemptLimit = $max_attempts_default;}
 1919       $continueFlag = "0" unless( defined($continueFlag) && @problemData );
 1920       # can't put continuation flag onto the first problem
 1921       push(@problemData, {source_file    => $name,
 1922                           value          =>  $value,
 1923                           max_attempts   =>, $attemptLimit,
 1924                           continuation   => $continueFlag
 1925                           });
 1926     }
 1927     close(SETFILENAME);
 1928     ($setName,
 1929      $paperHeaderFile,
 1930      $screenHeaderFile,
 1931      $time1,
 1932      $time2,
 1933      $time3,
 1934      \@problemData,
 1935      $assignmentType, $attemptsPerVersion, $timeInterval,
 1936      $versionsPerInterval, $versionTimeLimit, $problemRandOrder,
 1937      $problemsPerPage,
 1938      $hideScore,
 1939      $hideWork,
 1940      $timeCap,
 1941      $restrictIP,
 1942      $restrictLoc,
 1943      $relaxRestrictIP,
 1944     );
 1945   } else {
 1946     warn "Can't open file $filePath\n";
 1947   }
 1948 }
 1949 
 1950 sub exportSetsToDef {
 1951       my ($self, %filenames) = @_;
 1952 
 1953   my $r        = $self->r;
 1954   my $ce       = $r->ce;
 1955   my $db       = $r->db;
 1956 
 1957   my (@exported, @skipped, %reason);
 1958 
 1959 SET:  foreach my $set (keys %filenames) {
 1960 
 1961     my $fileName = $filenames{$set};
 1962     $fileName .= ".def" unless $fileName =~ m/\.def$/;
 1963     $fileName  = "set" . $fileName unless $fileName =~ m/^set/;
 1964     # files can be exported to sub directories but not parent directories
 1965     if ($fileName =~ /\.\./) {
 1966       push @skipped, $set;
 1967       $reason{$set} = "Illegal filename contains '..'";
 1968       next SET;
 1969     }
 1970 
 1971     my $setRecord = $db->getGlobalSet($set);
 1972     unless (defined $setRecord) {
 1973       push @skipped, $set;
 1974       $reason{$set} = "No record found.";
 1975       next SET;
 1976     }
 1977     my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName;
 1978 
 1979     # back up existing file
 1980     if(-e $filePath) {
 1981       rename($filePath, "$filePath.bak") or
 1982         $reason{$set} = "Existing file $filePath could not be backed up and was lost.";
 1983     }
 1984 
 1985     my $openDate     = $self->formatDateTime($setRecord->open_date);
 1986     my $dueDate      = $self->formatDateTime($setRecord->due_date);
 1987     my $answerDate   = $self->formatDateTime($setRecord->answer_date);
 1988     my $setHeader    = $setRecord->set_header;
 1989     my $paperHeader  = $setRecord->hardcopy_header;
 1990     my @problemList = $db->listGlobalProblems($set);
 1991 
 1992     my $problemList  = '';
 1993     foreach my $prob (sort {$a <=> $b} @problemList) {
 1994       # DBFIXME use an iterator?
 1995       my $problemRecord = $db->getGlobalProblem($set, $prob); # checked
 1996       unless (defined $problemRecord) {
 1997         push @skipped, $set;
 1998         $reason{$set} = "No record found for problem $prob.";
 1999         next SET;
 2000       }
 2001       my $source_file   = $problemRecord->source_file();
 2002       my $value         = $problemRecord->value();
 2003       my $max_attempts  = $problemRecord->max_attempts();
 2004 
 2005       # backslash-escape commas in fields
 2006       $source_file =~ s/([,\\])/\\$1/g;
 2007       $value =~ s/([,\\])/\\$1/g;
 2008       $max_attempts =~ s/([,\\])/\\$1/g;
 2009       $problemList     .= "$source_file, $value, $max_attempts \n";
 2010     }
 2011 
 2012     # gateway fields
 2013     my $assignmentType = $setRecord->assignment_type;
 2014     my $gwFields = '';
 2015     if ( $assignmentType =~ /gateway/ ) {
 2016         my $attemptsPerV = $setRecord->attempts_per_version;
 2017         my $timeInterval = $setRecord->time_interval;
 2018         my $vPerInterval = $setRecord->versions_per_interval;
 2019         my $vTimeLimit   = $setRecord->version_time_limit;
 2020         my $probRandom   = $setRecord->problem_randorder;
 2021         my $probPerPage  = $setRecord->problems_per_page;
 2022         my $hideScore    = $setRecord->hide_score;
 2023         my $hideWork     = $setRecord->hide_work;
 2024         my $timeCap      = $setRecord->time_limit_cap;
 2025         $gwFields =<<EOG;
 2026 
 2027 assignmentType      = $assignmentType
 2028 attemptsPerVersion  = $attemptsPerV
 2029 timeInterval        = $timeInterval
 2030 versionsPerInterval = $vPerInterval
 2031 versionTimeLimit    = $vTimeLimit
 2032 problemRandOrder    = $probRandom
 2033 problemsPerPage     = $probPerPage
 2034 hideScore           = $hideScore
 2035 hideWork            = $hideWork
 2036 capTimeLimit        = $timeCap
 2037 EOG
 2038         chomp($gwFields);
 2039     }
 2040 
 2041     # ip restriction fields
 2042     my $restrictIP = $setRecord->restrict_ip;
 2043     my $restrictFields = '';
 2044     if ( $restrictIP && $restrictIP ne 'No' ) {
 2045       # only store the first location
 2046       my $restrictLoc = ($db->listGlobalSetLocations($setRecord->set_id))[0];
 2047       my $relaxRestrict = $setRecord->relax_restrict_ip;
 2048       $restrictLoc || ($restrictLoc = '');
 2049       $restrictFields = "restrictIP          = $restrictIP" .
 2050           "\nrestrictLocation    = $restrictLoc\n" .
 2051           "relaxRestrictIP     = $relaxRestrict\n";
 2052     }
 2053 
 2054     my $fileContents = <<EOF;
 2055 
 2056 openDate          = $openDate
 2057 dueDate           = $dueDate
 2058 answerDate        = $answerDate
 2059 paperHeaderFile   = $paperHeader
 2060 screenHeaderFile  = $setHeader$gwFields
 2061 ${restrictFields}problemList       =
 2062 $problemList
 2063 EOF
 2064 
 2065     $filePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $filePath);
 2066     eval {
 2067       local *SETDEF;
 2068       open SETDEF, ">$filePath" or die "Failed to open $filePath";
 2069       print SETDEF $fileContents;
 2070       close SETDEF;
 2071     };
 2072 
 2073     if ($@) {
 2074       push @skipped, $set;
 2075       $reason{$set} = $@;
 2076     } else {
 2077       push @exported, $set;
 2078     }
 2079 
 2080   }
 2081 
 2082   return \@exported, \@skipped, \%reason;
 2083 
 2084 }
 2085 
 2086 ################################################################################
 2087 # "display" methods
 2088 ################################################################################
 2089 
 2090 sub fieldEditHTML {
 2091   my ($self, $fieldName, $value, $properties) = @_;
 2092   my $size = $properties->{size};
 2093   my $type = $properties->{type};
 2094   my $access = $properties->{access};
 2095   my $items = $properties->{items};
 2096   my $synonyms = $properties->{synonyms};
 2097   my $headerFiles = $self->{headerFiles};
 2098 
 2099   if ($access eq "readonly") {
 2100     return $value;
 2101   }
 2102 
 2103   if ($type eq "number" or $type eq "text") {
 2104     return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size});
 2105   }
 2106 
 2107   if ($type eq "filelist") {
 2108     return CGI::popup_menu({
 2109       name => $fieldName,
 2110       value => [ sort keys %$headerFiles ],
 2111       labels => $headerFiles,
 2112       default => $value || 0,
 2113     });
 2114   }
 2115 
 2116   if ($type eq "enumerable") {
 2117     my $matched = undef; # Whether a synonym match has occurred
 2118 
 2119     # Process synonyms for enumerable objects
 2120     foreach my $synonym (keys %$synonyms) {
 2121       if ($synonym ne "*" and $value =~ m/$synonym/) {
 2122         $value = $synonyms->{$synonym};
 2123         $matched = 1;
 2124       }
 2125     }
 2126 
 2127     if (!$matched and exists $synonyms->{"*"}) {
 2128       $value = $synonyms->{"*"};
 2129     }
 2130 
 2131     return CGI::popup_menu({
 2132       name => $fieldName,
 2133       values => [keys %$items],
 2134       default => $value,
 2135       labels => $items,
 2136     });
 2137   }
 2138 
 2139   if ($type eq "checked") {
 2140 
 2141     # FIXME: kludge (R)
 2142     # if the checkbox is checked it returns a 1, if it is unchecked it returns nothing
 2143     # in which case the hidden field overrides the parameter with a 0
 2144     return CGI::checkbox(
 2145       -name => $fieldName,
 2146       -checked => $value,
 2147       -label => "",
 2148       -value => 1
 2149     ) . CGI::hidden(
 2150       -name => $fieldName,
 2151       -value => 0
 2152     );
 2153   }
 2154 }
 2155 
 2156 sub recordEditHTML {
 2157   my ($self, $Set, %options) = @_;
 2158   my $r           = $self->r;
 2159   my $urlpath     = $r->urlpath;
 2160   my $ce          = $r->ce;
 2161   my $db    = $r->db;
 2162   my $authz = $r->authz;
 2163   my $user  = $r->param('user');
 2164   my $root        = $ce->{webworkURLs}->{root};
 2165   my $courseName  = $urlpath->arg("courseID");
 2166 
 2167   my $editMode = $options{editMode};
 2168   my $exportMode = $options{exportMode};
 2169   my $setSelected = $options{setSelected};
 2170 
 2171   my $visibleClass = $Set->visible ? "visible" : "hidden";
 2172   my $enable_reduced_scoringClass = $Set->enable_reduced_scoring ? 'Reduced Credit Enabled' : 'Reduced Credit Disabled';
 2173 
 2174   my $users = $db->countSetUsers($Set->set_id);
 2175   my $totalUsers = $self->{totalUsers};
 2176   # DBFIXME count would suffice
 2177   my $problems = $db->listGlobalProblems($Set->set_id);
 2178 
 2179         my $usersAssignedToSetURL  = $self->systemLink($urlpath->new(type=>'instructor_users_assigned_to_set', args=>{courseID => $courseName, setID => $Set->set_id} ));
 2180   my $problemListURL  = $self->systemLink($urlpath->new(type=>'instructor_set_detail', args=>{courseID => $courseName, setID => $Set->set_id} ));
 2181   my $problemSetListURL = $self->systemLink($urlpath->new(type=>'instructor_set_list', args=>{courseID => $courseName, setID => $Set->set_id})) . "&editMode=1&visible_sets=" . $Set->set_id;
 2182   my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/edit.gif";
 2183         my $imageLink = CGI::a({href => $problemSetListURL}, CGI::img({src=>$imageURL, border=>0}));
 2184 
 2185   my @tableCells;
 2186   my %fakeRecord;
 2187   my $set_id = $Set->set_id;
 2188 
 2189   $fakeRecord{select} = CGI::checkbox(-name => "selected_sets", -value => $set_id, -checked => $setSelected, -label => "", );
 2190 # $fakeRecord{set_id} = CGI::font({class=>$visibleClass}, $set_id) . ($editMode ? "" : $imageLink);
 2191   $fakeRecord{set_id} = $editMode
 2192           ? CGI::a({href=>$problemListURL}, "$set_id")
 2193           : CGI::font({class=>$visibleClass}, $set_id) . $imageLink;
 2194   $fakeRecord{problems} = (FIELD_PERMS()->{problems} and not $authz->hasPermissions($user, FIELD_PERMS()->{problems}))
 2195           ? "$problems"
 2196           : CGI::a({href=>$problemListURL}, "$problems");
 2197   $fakeRecord{users} = (FIELD_PERMS()->{users} and not $authz->hasPermissions($user, FIELD_PERMS()->{users}))
 2198           ? "$users/$totalUsers"
 2199           : CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers");
 2200   $fakeRecord{filename} = CGI::input({-name => "set.$set_id", -value=>"set$set_id.def", -size=>60});
 2201 
 2202 
 2203   # Select
 2204   if ($editMode) {
 2205     # column not there
 2206   } else {
 2207     # selection checkbox
 2208     push @tableCells, CGI::checkbox(
 2209       -name => "selected_sets",
 2210       -value => $set_id,
 2211       -checked => $setSelected,
 2212       -label => "",
 2213     );
 2214   }
 2215 
 2216   # Set ID
 2217   if ($editMode) {
 2218     push @tableCells, CGI::a({href=>$problemListURL}, "$set_id");
 2219   } else {
 2220   push @tableCells, CGI::font({class=>$visibleClass}, $set_id . $imageLink);
 2221   }
 2222 
 2223   # Problems link
 2224   if ($editMode) {
 2225     # column not there
 2226   } else {
 2227     # "problem list" link
 2228     push @tableCells, CGI::a({href=>$problemListURL}, "$problems");
 2229   }
 2230 
 2231   # Users link
 2232   if ($editMode) {
 2233     # column not there
 2234   } else {
 2235     # "edit users assigned to set" link
 2236     push @tableCells, CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers");
 2237   }
 2238 
 2239   # determine which non-key fields to show
 2240   my @fieldsToShow;
 2241   if ($editMode) {
 2242     @fieldsToShow = @{ EDIT_FIELD_ORDER() };
 2243   } elsif ($exportMode) {
 2244     @fieldsToShow = @{ EXPORT_FIELD_ORDER() };
 2245   } else {
 2246     @fieldsToShow = @{ VIEW_FIELD_ORDER() };
 2247   }
 2248 
 2249   # make a hash out of this so we can test membership easily
 2250   my %nonkeyfields; @nonkeyfields{$Set->NONKEYFIELDS} = ();
 2251 
 2252   # Set Fields
 2253   foreach my $field (@fieldsToShow) {
 2254     next unless exists $nonkeyfields{$field};
 2255     my $fieldName = "set." . $set_id . "." . $field,
 2256     my $fieldValue = $Set->$field;
 2257     my %properties = %{ FIELD_PROPERTIES()->{$field} };
 2258     $properties{access} = "readonly" unless $editMode;
 2259     $fieldValue = $self->formatDateTime($fieldValue) if $field =~ /_date/;
 2260     $fieldValue =~ s/ /&nbsp;/g unless $editMode;
 2261     $fieldValue = ($fieldValue) ? "Yes" : "No" if $field =~ /visible/ and not $editMode;
 2262     $fieldValue = ($fieldValue) ? "Yes" : "No" if $field =~ /enable_reduced_scoring/ and not $editMode;
 2263     push @tableCells, CGI::font({class=>$visibleClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties));
 2264     #$fakeRecord{$field} = CGI::font({class=>$visibleClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties));
 2265   }
 2266 
 2267   #@tableCells = map { $fakeRecord{$_} } @fieldsToShow;
 2268 
 2269   return CGI::Tr({}, CGI::td({}, \@tableCells));
 2270 }
 2271 
 2272 sub printTableHTML {
 2273   my ($self, $SetsRef, $fieldNamesRef, %options) = @_;
 2274   my $r                       = $self->r;
 2275   my $authz                   = $r->authz;
 2276   my $user                    = $r->param('user');
 2277   my $setTemplate             = $self->{setTemplate};
 2278   my @Sets                    = @$SetsRef;
 2279   my %fieldNames              = %$fieldNamesRef;
 2280 
 2281   my $editMode                = $options{editMode};
 2282   my $exportMode              = $options{exportMode};
 2283   my %selectedSetIDs          = map { $_ => 1 } @{ $options{selectedSetIDs} };
 2284   my $currentSort             = $options{currentSort};
 2285 
 2286   # names of headings:
 2287   my @realFieldNames = (
 2288       $setTemplate->KEYFIELDS,
 2289       $setTemplate->NONKEYFIELDS,
 2290   );
 2291 
 2292   if ($editMode) {
 2293     @realFieldNames = @{ EDIT_FIELD_ORDER() };
 2294   } else {
 2295     @realFieldNames = @{ VIEW_FIELD_ORDER() };
 2296   }
 2297 
 2298   if ($exportMode) {
 2299     @realFieldNames = @{ EXPORT_FIELD_ORDER() };
 2300   }
 2301 
 2302 
 2303   my %sortSubs = %{ SORT_SUBS() };
 2304 
 2305   # FIXME: should this always presume to use the templates directory?
 2306   # (no, but that can wait until we have an abstract ProblemLibrary API -- sam)
 2307   my $templates_dir = $r->ce->{courseDirs}->{templates};
 2308   my $exempt_dirs = join "|", keys %{ $r->ce->{courseFiles}->{problibs} };
 2309   my @headers = listFilesRecursive(
 2310     $templates_dir,
 2311     qr/header.*\.pg$/i, # match these files
 2312     qr/^(?:$exempt_dirs|CVS)$/, # prune these directories
 2313     0, # match against file name only
 2314     1, # prune against path relative to $templates_dir
 2315   );
 2316 
 2317   @headers = sort @headers;
 2318   my %headers = map { $_ => $_ } @headers;
 2319   $headers{""} = "Use System Default";
 2320   $self->{headerFiles} = \%headers; # store these header files so we don't have to look for them later.
 2321 
 2322 
 2323   my @tableHeadings = map { $fieldNames{$_} } @realFieldNames;
 2324 
 2325   # prepend selection checkbox? only if we're NOT editing!
 2326 # unshift @tableHeadings, "Select", "Set", "Problems" unless $editMode;
 2327 
 2328   # print the table
 2329   if ($editMode or $exportMode) {
 2330     print CGI::start_table({});
 2331   } else {
 2332     print CGI::start_table({-border=>1});
 2333   }
 2334 
 2335   print CGI::Tr({}, CGI::th({}, \@tableHeadings));
 2336 
 2337 
 2338   for (my $i = 0; $i < @Sets; $i++) {
 2339     my $Set = $Sets[$i];
 2340 
 2341     print $self->recordEditHTML($Set,
 2342       editMode => $editMode,
 2343       exportMode => $exportMode,
 2344       setSelected => exists $selectedSetIDs{$Set->set_id}
 2345     );
 2346   }
 2347 
 2348   print CGI::end_table();
 2349   #########################################
 2350   # if there are no users shown print message
 2351   #
 2352   ##########################################
 2353 
 2354   print CGI::p(
 2355                       CGI::i("No sets shown.  Choose one of the options above to list the sets in the course.")
 2356   ) unless @Sets;
 2357 }
 2358 
 2359 1;
 2360 
 2361 =head1 AUTHOR
 2362 
 2363 Written by Robert Van Dam, toenail (at) cif.rochester.edu
 2364 
 2365 =cut

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9