################################################################################ # WeBWorK Online Homework Delivery System # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ # # # This program is free software; you can redistribute it and/or modify it under # the terms of either: (a) the GNU General Public License as published by the # Free Software Foundation; either version 2, or (at your option) any later # version, or (b) the "Artistic License" which comes with this package. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the # Artistic License for more details. ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemSetDetail; use base qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME WeBWorK::ContentGenerator::Instructor::ProblemSetDetail - Edit general set and specific user/set information as well as problem information =cut use strict; use warnings; #use CGI qw(-nosticky ); use WeBWorK::CGI; use WeBWorK::HTML::ComboBox qw/comboBox/; use WeBWorK::Utils qw(readDirectory list2hash listFilesRecursive max cryptPassword); use WeBWorK::Utils::Tasks qw(renderProblems); use WeBWorK::Debug; # IP RESTRICT use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; # Important Note: the following two sets of constants may seem similar # but they are functionally and semantically different # these constants determine which fields belong to what type of record use constant SET_FIELDS => [qw(set_header hardcopy_header open_date due_date answer_date published restrict_ip relax_restrict_ip assignment_type attempts_per_version version_time_limit time_limit_cap versions_per_interval time_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work)]; use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts)]; use constant USER_PROBLEM_FIELDS => [qw(problem_seed status num_correct num_incorrect)]; # these constants determine what order those fields should be displayed in use constant HEADER_ORDER => [qw(set_header hardcopy_header)]; use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts attempted last_answer num_correct num_incorrect)]; # we exclude the gateway set fields from the set field order, because they # are only displayed for sets that are gateways. this results in a bit of # convoluted logic below, but it saves burdening people who are only using # homework assignments with all of the gateway parameters # FIXME: in the long run, we may want to let hide_score and hide_work be # FIXME: set for non-gateway assignments. right now (11/30/06) they are # FIXME: only used for gateways use constant SET_FIELD_ORDER => [qw(open_date due_date answer_date published restrict_ip relax_restrict_ip assignment_type)]; # use constant GATEWAY_SET_FIELD_ORDER => [qw(attempts_per_version version_time_limit time_interval versions_per_interval problem_randorder problems_per_page hide_score hide_work)]; use constant GATEWAY_SET_FIELD_ORDER => [qw(version_time_limit time_limit_cap attempts_per_version time_interval versions_per_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work)]; # this constant is massive hash of information corresponding to each db field. # override indicates for how many students at a time a field can be overridden # this hash should make it possible to NEVER have explicitly: if (somefield) { blah() } # # All but name are optional # some_field => { # name => "Some Field", # type => "edit", # edit, choose, hidden, view - defines how the data is displayed # size => "50", # size of the edit box (if any) # override => "none", # none, one, any, all - defines for whom this data can/must be overidden # module => "problem_list", # WeBWorK module # default => 0 # if a field cannot default to undefined/empty what should it default to # labels => { # special values can be hashed to display labels # 1 => "Yes", # 0 => "No", # }, # convertby => 60, # divide incoming database field values by this, and multiply when saving use constant BLANKPROBLEM => 'blankProblem.pg'; use constant FIELD_PROPERTIES => { # Set information set_header => { name => "Set Header", type => "edit", size => "50", override => "all", module => "problem_list", default => "", }, hardcopy_header => { name => "Hardcopy Header", type => "edit", size => "50", override => "all", module => "hardcopy_preselect_set", default => "", }, open_date => { name => "Opens", type => "edit", size => "26", override => "any", labels => { #0 => "None Specified", "" => "None Specified", }, }, due_date => { name => "Answers Due", type => "edit", size => "26", override => "any", labels => { #0 => "None Specified", "" => "None Specified", }, }, answer_date => { name => "Answers Available", type => "edit", size => "26", override => "any", labels => { #0 => "None Specified", "" => "None Specified", }, }, published => { name => "Visible to Students", type => "choose", override => "all", choices => [qw( 0 1 )], labels => { 1 => "Yes", 0 => "No", }, }, restrict_ip => { name => "Restrict Access by IP", type => "choose", override => "any", choices => [qw( No RestrictTo DenyFrom )], labels => { No => "No", RestrictTo => "Restrict To", DenyFrom => "Deny From", }, default => 'No', }, relax_restrict_ip => { name => "Relax IP restrictions when?", type => "choose", override => "any", choices => [qw( No AfterAnswerDate AfterVersionAnswerDate )], labels => { No => "Never", AfterAnswerDate => "After set answer date", AfterVersionAnswerDate => "(gw/quiz) After version answer date", }, default => 'No', }, assignment_type => { name => "Assignment type", type => "choose", override => "all", choices => [qw( default gateway proctored_gateway )], labels => { default => "homework", gateway => "gateway/quiz", proctored_gateway => "proctored gateway/quiz", }, }, version_time_limit => { name => "Test Time Limit (min)", type => "edit", size => "4", override => "any", # labels => { "" => 0 }, # I'm not sure this is quite right convertby => 60, }, time_limit_cap => { name => "Cap Test Time at Set Due Date?", type => "choose", override => "all", choices => [qw(0 1)], labels => { '0' => 'No', '1' => 'Yes' }, }, attempts_per_version => { name => "Number of Graded Submissions per Test", type => "edit", size => "3", override => "any", # labels => { "" => 1 }, }, time_interval => { name => "Time Interval for New Test Versions (min; 0=infty)", type => "edit", size => "5", override => "any", # labels => { "" => 0 }, convertby => 60, }, versions_per_interval => { name => "Number of Tests per Time Interval (0=infty)", type => "edit", size => "3", override => "any", default => "0", format => '[0-9]+', # an integer, possibly zero # labels => { "" => 0 }, # labels => { "" => 1 }, }, problem_randorder => { name => "Order Problems Randomly", type => "choose", choices => [qw( 0 1 )], override => "any", labels => { 0 => "No", 1 => "Yes" }, }, problems_per_page => { name => "Number of Problems per Page (0=all)", type => "edit", size => "3", override => "any", default => "0", # labels => { "" => 0 }, }, 'hide_score:hide_score_by_problem' => { name => "Show Scores on Finished Assignments?", type => "choose", choices => [ qw( N: Y:N BeforeAnswerDate:N Y:Y BeforeAnswerDate:Y ) ], override => "any", labels => { 'N:' => 'Yes', 'Y:N' => 'No', 'BeforeAnswerDate:N' => 'Only after set answer date', 'Y:Y' => 'Totals only (not problem scores)', 'BeforeAnswerDate:Y' => 'Totals only, only after answer date' }, }, hide_work => { name => "Show Student Work on Finished Tests", type => "choose", choices => [ qw(N Y BeforeAnswerDate) ], override => "any", labels => { 'N' => "Yes", 'Y' => "No", 'BeforeAnswerDate' => 'Only after set answer date' }, }, # in addition to the set fields above, there are a number of things # that are set but aren't in this table: # any set proctor information (which is in the user tables), and # any set location restriction information (which is in the # location tables) # # Problem information source_file => { name => "Source File", type => "edit", size => 50, override => "any", default => "", }, value => { name => "Weight", type => "edit", size => 6, override => "any", }, max_attempts => { name => "Max attempts", type => "edit", size => 6, override => "any", labels => { "-1" => "unlimited", }, }, problem_seed => { name => "Seed", type => "edit", size => 6, override => "one", }, status => { name => "Status", type => "edit", size => 6, override => "one", default => 0, }, attempted => { name => "Attempted", type => "hidden", override => "none", choices => [qw( 0 1 )], labels => { 1 => "Yes", 0 => "No", }, default => 0, }, last_answer => { name => "Last Answer", type => "hidden", override => "none", }, num_correct => { name => "Correct", type => "hidden", override => "none", default => 0, }, num_incorrect => { name => "Incorrect", type => "hidden", override => "none", default => 0, }, }; # Create a table of fields for the given parameters, one row for each db field # if only the setID is included, it creates a table of set information # if the problemID is included, it creates a table of problem information sub FieldTable { my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord) = @_; my $r = $self->r; my @editForUser = $r->param('editForUser'); my $forUsers = scalar(@editForUser); my $forOneUser = $forUsers == 1; my @fieldOrder; # needed for gateway output my $gwFields = ''; # needed for ip restrictions my $ipFields = ''; my $ipDefaults; my $numLocations = 0; my $ipOverride; # needed for set-level proctor my $procFields = ''; if (defined $problemID) { @fieldOrder = @{ PROBLEM_FIELD_ORDER() }; } else { @fieldOrder = @{ SET_FIELD_ORDER() }; ($gwFields, $ipFields, $numLocations, $procFields) = $self->extraSetFields($userID, $setID, $globalRecord, $userRecord, $forUsers); } my $output = CGI::start_table({border => 0, cellpadding => 1}); if ($forUsers) { $output .= CGI::Tr({}, CGI::th({colspan=>"2"}, " "), CGI::th({colspan=>"1"}, "User Values"), CGI::th({}, "Class values"), ); } foreach my $field (@fieldOrder) { my %properties = %{ FIELD_PROPERTIES()->{$field} }; # we don't show the ip restriction option if there are # no defined locations, nor the relax_restrict_ip option # if we're not restricting ip access next if ( $field eq 'restrict_ip' && ! $numLocations ); next if ($field eq 'relax_restrict_ip' && (! $numLocations || ($forUsers && $userRecord->restrict_ip eq 'No') || (! $forUsers && ( $globalRecord->restrict_ip eq '' || $globalRecord->restrict_ip eq 'No' ) ) ) ); unless ($properties{type} eq "hidden") { $output .= CGI::Tr({}, CGI::td({}, [$self->FieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field)])) . "\n"; } # finally, put in extra fields that are exceptions to the # usual display mechanism if ( $field eq 'restrict_ip' && $ipFields ) { $output .= $ipFields; } if ( $field eq 'assignment_type' ) { $output .= "$procFields\n$gwFields\n"; } } if (defined $problemID) { #my $problemRecord = $r->{db}->getUserProblem($userID, $setID, $problemID); my $problemRecord = $userRecord; # we get this from the caller, hopefully $output .= CGI::Tr({}, CGI::td({}, ["","Attempts", ($problemRecord->num_correct || 0) + ($problemRecord->num_incorrect || 0)])) if $forOneUser; } $output .= CGI::end_table(); return $output; } # Returns a list of information and HTML widgets # for viewing and editing the specified db fields # if only the setID is included, it creates a list of set information # if the problemID is included, it creates a list of problem information sub FieldHTML { my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $field) = @_; my $r = $self->r; my $db = $r->db; my @editForUser = $r->param('editForUser'); my $forUsers = scalar(@editForUser); my $forOneUser = $forUsers == 1; #my ($globalRecord, $userRecord, $mergedRecord); #if (defined $problemID) { # $globalRecord = $db->getGlobalProblem($setID, $problemID); # $userRecord = $db->getUserProblem($userID, $setID, $problemID); # #$mergedRecord = $db->getMergedProblem($userID, $setID, $problemID); # never used --sam #} else { # $globalRecord = $db->getGlobalSet($setID); # $userRecord = $db->getUserSet($userID, $setID); # #$mergedRecord = $db->getMergedSet($userID, $setID); # never user --sam #} return "No data exists for set $setID and problem $problemID" unless $globalRecord; return "No user specific data exists for user $userID" if $forOneUser and $globalRecord and not $userRecord; my %properties = %{ FIELD_PROPERTIES()->{$field} }; my %labels = %{ $properties{labels} }; return "" if $properties{type} eq "hidden"; return "" if $properties{override} eq "one" && not $forOneUser; return "" if $properties{override} eq "none" && not $forOneUser; return "" if $properties{override} eq "all" && $forUsers; my $edit = ($properties{type} eq "edit") && ($properties{override} ne "none"); my $choose = ($properties{type} eq "choose") && ($properties{override} ne "none"); # FIXME: allow one selector to set multiple fields # my $globalValue = $globalRecord->{$field}; # my $userValue = $userRecord->{$field}; my ($globalValue, $userValue) = ('', ''); my $blankfield = ''; if ( $field =~ /:/ ) { my @gVals = (); my @uVals = (); my @bVals = (); foreach my $f ( split(/:/, $field) ) { # hmm. this directly references the data in the # record rather than calling the access method, # thereby avoiding errors if the userRecord is # undefined. that seems a bit suspect, but it's # used below so we'll leave it here. push(@gVals, $globalRecord->{$f} ); push(@uVals, $userRecord->{$f} ); # (defined($userRecord->{$f})?$userRecord->{$f}:'') ); push(@bVals, ''); } # I don't like this, but combining multiple values is a bit messy $globalValue = (grep {defined($_)} @gVals) ? join(':', (map { defined($_) ? $_ : '' } @gVals )) : undef; $userValue = (grep {defined($_)} @uVals) ? join(':', (map { defined($_) ? $_ : '' } @uVals )) : undef; $blankfield = join(':', @bVals); } else { $globalValue = $globalRecord->{$field}; $userValue = $userRecord->{$field}; } # use defined instead of value in order to allow 0 to printed, e.g. for the 'value' field $globalValue = (defined($globalValue)) ? ($labels{$globalValue || ""} || $globalValue) : ""; $userValue = (defined($userValue)) ? ($labels{$userValue || ""} || $userValue) : $blankfield; if ($field =~ /_date/) { $globalValue = $self->formatDateTime($globalValue) if defined $globalValue && $globalValue ne $labels{""}; $userValue = $self->formatDateTime($userValue) if defined $userValue && $userValue ne $labels{""}; } if ( defined($properties{convertby}) && $properties{convertby} ) { $globalValue = $globalValue/$properties{convertby} if $globalValue; $userValue = $userValue/$properties{convertby} if $userValue; } # check to make sure that a given value can be overridden my %canOverride = map { $_ => 1 } (@{ PROBLEM_FIELDS() }, @{ SET_FIELDS() }); my $check = $canOverride{$field}; # $recordType is a shorthand in the return statement for problem or set # $recordID is a shorthand in the return statement for $problemID or $setID my $recordType = ""; my $recordID = ""; if (defined $problemID) { $recordType = "problem"; $recordID = $problemID; } else { $recordType = "set"; $recordID = $setID; } # $inputType contains either an input box or a popup_menu for changing a given db field my $inputType = ""; if ($edit) { $inputType = CGI::input({ name => "$recordType.$recordID.$field", value => $r->param("$recordType.$recordID.$field") || ($forUsers ? $userValue : $globalValue), size => $properties{size} || 5, }); } elsif ($choose) { # Note that in popup menus, you're almost guaranteed to have the choices hashed to labels in %properties # but $userValue and and $globalValue are the values in the hash not the keys # so we have to use the actual db record field values to select our default here. # FIXME: this allows us to set one selector from two (or more) fields # if $field matches /:/, we have to get two fields to get the data we need here my $value = $r->param("$recordType.$recordID.$field"); if ( ! $value && $field =~ /:/ ) { my @fields = split(/:/, $field); $value = ''; foreach my $f ( @fields ) { $value .= ($forUsers && $userRecord->$f ne '' ? $userRecord->$f : $globalRecord->$f) . ":"; } $value =~ s/:$//; } elsif ( ! $value ) { $value = ($forUsers && $userRecord->$field ne '' ? $userRecord->$field : $globalRecord->$field); } $inputType = CGI::popup_menu({ name => "$recordType.$recordID.$field", values => $properties{choices}, labels => \%labels, default => $value, }); } my $gDisplVal = defined($properties{labels}) && defined($properties{labels}->{$globalValue}) ? $properties{labels}->{$globalValue} : $globalValue; # FIXME: adding ":" in the checked => allows for multiple fields to be set by one selector # return (($forUsers && $edit && $check) ? CGI::checkbox({ return (($forUsers && $check) ? CGI::checkbox({ type => "checkbox", name => "$recordType.$recordID.$field.override", label => "", value => $field, checked => $r->param("$recordType.$recordID.$field.override") || ($userValue ne ($labels{""} || $blankfield) ? 1 : 0), }) : "", $properties{name}, $inputType, $forUsers ? " $gDisplVal" : "", ); } # return weird fields that are non-native or which are displayed # for only some sets sub extraSetFields { my ($self,$userID,$setID,$globalRecord,$userRecord,$forUsers) = @_; my $db = $self->r->{db}; my ($gwFields, $ipFields, $ipDefaults, $numLocations, $ipOverride, $procFields) = ( '', '', '', 0, '', '' ); # if we're dealing with a gateway, set up a table of gateway fields my $nF = 0; # this is the number of columns in the set field table if ( $globalRecord->assignment_type() =~ /gateway/ ) { my $gwhdr = "\n\n"; foreach my $gwfield ( @{ GATEWAY_SET_FIELD_ORDER() } ) { my @fieldData = ($self->FieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $gwfield)); if ( @fieldData && defined($fieldData[1]) and $fieldData[1] ne '' ) { $nF = @fieldData if ( @fieldData > $nF ); $gwFields .= CGI::Tr({}, CGI::td({}, [@fieldData])); } } $gwhdr .= CGI::Tr({},CGI::td({colspan=>$nF}, CGI::em("Gateway parameters"))) if ( $nF ); $gwFields = "$gwhdr$gwFields\n" . "\n"; } # if we have a proctored test, then also generate a proctored # set password input if ( $globalRecord->assignment_type eq 'proctored_gateway' && ! $forUsers ) { my $nfm1 = $nF - 1; $procFields = CGI::Tr({},CGI::td({},''), CGI::td({colspan=>$nfm1}, CGI::em("Proctored tests require proctor " . "authorization to start and to " . "grade. Provide a password to have " . "a single password for all students " . "to start a proctored test."))); # we use a routine other than FieldHTML because of getting # the default value here my @fieldData = $self->proctoredFieldHTML($userID, $setID, $globalRecord); $procFields .= CGI::Tr({}, CGI::td({}, [@fieldData])); } # finally, figure out what ip selector fields we want to include my @locations = sort {$a cmp $b} ($db->listLocations()); $numLocations = @locations; if ( ( ! $forUsers && $globalRecord->restrict_ip && $globalRecord->restrict_ip ne 'No' ) || ( $forUsers && $userRecord->restrict_ip ne 'No' ) ) { my @globalLocations = $db->listGlobalSetLocations($setID); # what ip locations should be selected? my @defaultLocations = (); if ( $forUsers && ! $db->countUserSetLocations($userID, $setID) ) { @defaultLocations = @globalLocations; $ipOverride = 0; } elsif ( $forUsers ) { @defaultLocations = $db->listUserSetLocations($userID, $setID); $ipOverride = 1; } else { @defaultLocations = @globalLocations; } my $ipDefaults = join(', ', @globalLocations); my $ipSelector = CGI::scrolling_list({ -name => "set.$setID.selected_ip_locations", -values => [ @locations ], -default => [ @defaultLocations ], -size => 5, -multiple => 'true'}); my $override = ($forUsers) ? CGI::checkbox({ type => "checkbox", name => "set.$setID.selected_ip_locations.override", label => "", checked => $ipOverride }) : ''; $ipFields .= CGI::Tr({-valign=>'top'}, CGI::td({}, [ $override, 'Restrict Locations', $ipSelector, $forUsers ? " $ipDefaults" : '', ] ), ); } return($gwFields, $ipFields, $numLocations, $procFields); } sub proctoredFieldHTML { my ( $self, $userID, $setID, $globalRecord ) = @_; my $r = $self->r; my $db = $r->db; # note that this routine assumes that the login proctor password # is something that can only be changed for the global set # if the set doesn't require a login proctor, then we can assume # that one doesn't exist; otherwise, we need to check the # database to find if there's an already defined password my $value = ''; if ( $globalRecord->restricted_login_proctor eq 'Yes' && $db->existsPassword("set_id:$setID") ) { $value = '********'; } return( ( '', 'Password (Leave blank for regular proctoring)', CGI::input({ name=>"set.$setID.restricted_login_proctor_password", value=>$value, size=>10, }), '' ) ); } # creates a popup menu of all possible problem numbers (for possible rearranging) sub problem_number_popup { my $num = shift; my $total = shift; return (CGI::popup_menu(-name => "problem_num_$num", -values => [1..$total], -default => $num)); } # handles rearrangement necessary after changes to problem ordering sub handle_problem_numbers { my $newProblemNumbersref = shift; my %newProblemNumbers = %$newProblemNumbersref; my $maxNum = shift; my $db = shift; my $setID = shift; my $force = shift || 0; my @sortme=(); my ($j, $val); # keys are current problem numbers, values are target problem numbers foreach $j (keys %newProblemNumbers) { # we don't want to act unless all problems have been assigned a new problem number, so if any have not, return return "" if (not defined $newProblemNumbers{"$j"}); # if the problem has been given a new number, we reduce the "score" of the problem by the original number of the problem # when multiple problems are assigned the same number, this results in the last one ending up first -- FIXME? if ($newProblemNumbers{"$j"} != $j) { # force always gets set if reordering is done, so don't expect to be able to delete a problem, # reorder some other problems, and end up with a hole -- FIXME $force = 1; $val = 1000 * $newProblemNumbers{$j} - $j; } else { $val = 1000 * $newProblemNumbers{$j}; } # store a mapping between current problem number and score (based on currnet and new problem number) push @sortme, [$j, $val]; # replace new problem numbers in hash with the (global) problems themselves $newProblemNumbers{$j} = $db->getGlobalProblem($setID, $j); die "global $j for set $setID not found." unless $newProblemNumbers{$j}; } # we don't have to do anything if we're not getting rid of holes return "" unless $force; # sort the curr. prob. num./score pairs by score @sortme = sort {$a->[1] <=> $b->[1]} @sortme; # now, for global and each user with this set, loop through problem list # get all of the problem records # assign new problem numbers # loop - if number is new, put the problem record # print "Sorted to get ". join(', ', map {$_->[0] } @sortme) ."

\n"; # Now, three stages. First global values for ($j = 0; $j < scalar @sortme; $j++) { if($sortme[$j][0] == $j + 1) { # if the jth problem (according to the new ordering) is in the right place (problem IDs are numbered from 1, hence $j+1) # do nothing } elsif (not defined $newProblemNumbers{$j + 1}) { # otherwise, if there's a hole for it, add it there $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); $db->addGlobalProblem($newProblemNumbers{$sortme[$j][0]}); } else { # otherwise, overwrite the data for the problem that's already there with the jth problem's data (with a changed problemID) $newProblemNumbers{$sortme[$j][0]}->problem_id($j + 1); $db->putGlobalProblem($newProblemNumbers{$sortme[$j][0]}); } } my @setUsers = $db->listSetUsers($setID); my (@problist, $user); foreach $user (@setUsers) { # grab a copy of each UserProblem for this user. @problist can be sparse (if problems were deleted) for $j (keys %newProblemNumbers) { $problist[$j] = $db->getUserProblem($user, $setID, $j); } for($j = 0; $j < scalar @sortme; $j++) { if ($sortme[$j][0] == $j + 1) { # same as above -- the jth problem is in the right place, so don't worry about it # do nothing } elsif ($problist[$sortme[$j][0]]) { # we've made sure the user's problem actually exists HERE, since we want to be able to fail gracefullly if it doesn't # the problem with the original conditional below is that %newProblemNumbers maps oldids => global problem record # we need to check if the target USER PROBLEM exists, which is what @problist knows #if (not defined $newProblemNumbers{$j + 1}) { if (not defined $problist[$j+1]) { # same as above -- there's a hole for that problem to go into, so add it in its new place $problist[$sortme[$j][0]]->problem_id($j + 1); $db->addUserProblem($problist[$sortme[$j][0]]); } else { # same as above -- there's a problem already there, so overwrite its data with the data from the jth problem $problist[$sortme[$j][0]]->problem_id($j + 1); $db->putUserProblem($problist[$sortme[$j][0]]); } } else { warn "UserProblem missing for user=$user set=$setID problem=$sortme[$j][0]. This may indicate database corruption.\n"; # when a problem doesn't exist in the target slot, a new problem gets added there, but the original problem # never gets overwritten (because there wan't a problem it would have to get exchanged with) # i think this can get pretty complex. consider 1=>2, 2=>3, 3=>4, 4=>1 where problem 1 doesn't exist for some user: # @sortme[$j][0] will contain: 4, 1, 2, 3 # - problem 1 will get **added** with the data from problem 4 (because problem 1 doesn't exist for this user) # - problem 2 will get overwritten with the data from problem 1 # - problem 3 will get overwritten with the data from problem 2 # - nothing will happend to problem 4, since problem 1 doesn't exit # so the solution is to delete problem 4 altogether! # here's the fix: # the data from problem $j+1 was/will be moved to another problem slot, # but there's no problem $sortme[$j][0] to replace it. thus, we delete it now. $db->deleteUserProblem($user, $setID, $j+1); } } } # any problems with IDs above $maxNum get deleted -- presumably their data has been copied into problems with lower IDs foreach ($j = scalar @sortme; $j < $maxNum; $j++) { if (defined $newProblemNumbers{$j + 1}) { $db->deleteGlobalProblem($setID, $j+1); } } # return a string form of the old problem IDs in the new order (not used by caller, incidentally) return join(', ', map {$_->[0]} @sortme); } # swap index given with next bigger index # leftover from when we had up/down buttons # maybe we will bring them back #sub moveme { # my $index = shift; # my $db = shift; # my $setID = shift; # my (@problemIDList) = @_; # my ($prob1, $prob2, $prob); # # foreach my $problemID (@problemIDList) { # my $problemRecord = $db->getGlobalProblem($setID, $problemID); # checked # die "global $problemID for set $setID not found." unless $problemRecord; # if ($problemRecord->problem_id == $index) { # $prob1 = $problemRecord; # } elsif ($problemRecord->problem_id == $index + 1) { # $prob2 = $problemRecord; # } # } # if (not defined $prob1 or not defined $prob2) { # die "cannot find problem $index or " . ($index + 1); # } # # $prob1->problem_id($index + 1); # $prob2->problem_id($index); # $db->putGlobalProblem($prob1); # $db->putGlobalProblem($prob2); # # my @setUsers = $db->listSetUsers($setID); # # my $user; # foreach $user (@setUsers) { # $prob1 = $db->getUserProblem($user, $setID, $index); #checked # die " problem $index for set $setID and effective user $user not found" # unless $prob1; # $prob2 = $db->getUserProblem($user, $setID, $index+1); #checked # die " problem $index for set $setID and effective user $user not found" # unless $prob2; # $prob1->problem_id($index+1); # $prob2->problem_id($index); # $db->putUserProblem($prob1); # $db->putUserProblem($prob2); # } #} # primarily saves any changes into the correct set or problem records (global vs user) # also deals with deleting or rearranging problems sub initialize { my ($self) = @_; my $r = $self->r; my $db = $r->db; my $ce = $r->ce; my $authz = $r->authz; my $user = $r->param('user'); my $setID = $r->urlpath->arg("setID"); my $setRecord = $db->getGlobalSet($setID); # checked die "global set $setID not found." unless $setRecord; $self->{set} = $setRecord; my @editForUser = $r->param('editForUser'); # some useful booleans my $forUsers = scalar(@editForUser); my $forOneUser = $forUsers == 1; # Check permissions return unless ($authz->hasPermissions($user, "access_instructor_tools")); return unless ($authz->hasPermissions($user, "modify_problem_sets")); my %properties = %{ FIELD_PROPERTIES() }; # takes a hash of hashes and inverts it my %undoLabels; foreach my $key (keys %properties) { %{ $undoLabels{$key} } = map { $properties{$key}->{labels}->{$_} => $_ } keys %{ $properties{$key}->{labels} }; } # Unfortunately not everyone uses Javascript enabled browsers so # we must fudge the information coming from the ComboBoxes # Since the textfield and menu both have the same name, we get an array of two elements # We then reset the param to the first if its not-empty or the second (empty or not). foreach ( @{ HEADER_ORDER() } ) { my @values = $r->param("set.$setID.$_"); my $value = $values[0] || $values[1] || ""; $r->param("set.$setID.$_", $value); } ##################################################################### # Check date information ##################################################################### my ($open_date, $due_date, $answer_date); my $error = 0; if (defined $r->param('submit_changes')) { my @names = ("open_date", "due_date", "answer_date"); my %dates = map { $_ => $r->param("set.$setID.$_") } @names; %dates = map { my $unlabel = $undoLabels{$_}->{$dates{$_}}; $_ => defined $unlabel ? $setRecord->$_ : $self->parseDateTime($dates{$_}) } @names; ($open_date, $due_date, $answer_date) = map { $dates{$_} } @names; if ($answer_date < $due_date || $answer_date < $open_date) { $self->addbadmessage("Answers cannot be made available until on or after the due date!"); $error = $r->param('submit_changes'); } if ($due_date < $open_date) { $self->addbadmessage("Answers cannot be due until on or after the open date!"); $error = $r->param('submit_changes'); } # make sure the dates are not more than 10 years in the future my $curr_time = time; my $seconds_per_year = 31_556_926; my $cutoff = $curr_time + $seconds_per_year*10; if ($open_date > $cutoff) { $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); $error = $r->param('submit_changes'); } if ($due_date > $cutoff) { $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); $error = $r->param('submit_changes'); } if ($answer_date > $cutoff) { $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); $error = $r->param('submit_changes'); } } if ($error) { $self->addbadmessage("No changes were saved!"); } if (defined $r->param('submit_changes') && !$error) { #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam ##################################################################### # Save general set information (including headers) ##################################################################### if ($forUsers) { # note that we don't deal with the proctor user # fields here, with the assumption that it can't # be possible to change them for users. this is # not the most robust treatment of the problem # (FIXME) # DBFIXME use a WHERE clause, iterator my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser); foreach my $record (@userRecords) { foreach my $field ( @{ SET_FIELDS() } ) { next unless canChange($forUsers, $field); my $override = $r->param("set.$setID.$field.override"); if (defined $override && $override eq $field) { my $param = $r->param("set.$setID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; # $param = $undoLabels{$field}->{$param} || $param; if ($field =~ /_date/) { $param = $self->parseDateTime($param) unless defined $unlabel; } if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { $param = $param*$properties{$field}->{convertby}; } # special case; does field fill in multiple values? if ( $field =~ /:/ ) { my @values = split(/:/, $param); my @fields = split(/:/, $field); for ( my $i=0; $i<@values; $i++ ) { my $f=$fields[$i]; $record->$f($values[$i]); } } else { $record->$field($param); } } else { #################### # FIXME: allow one selector to set multiple fields # if ( $field =~ /:/ ) { foreach my $f ( split(/:/, $field) ) { $record->$f(undef); } } else { $record->$field(undef); } } } #################### # FIXME: this is replaced by our allowing multiple fields to be set by one selector # a check for hiding scores: if we have # $set->hide_score eq 'N', we also want # $set->hide_score_by_problem eq 'N' # if ( $record->hide_score eq 'N' ) { # $record->hide_score_by_problem('N'); # } #################### $db->putUserSet($record); } ####################################################### # Save IP restriction Location information ####################################################### # FIXME: it would be nice to have this in the field values # hash, so that we don't have to assume that we can # override this information for users if ( $r->param("set.$setID.selected_ip_locations.override") ) { foreach my $record ( @userRecords ) { my $userID = $record->user_id; my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); my @userSetLocations = $db->listUserSetLocations($userID,$setID); my @addSetLocations = (); my @delSetLocations = (); foreach my $loc ( @selectedLocations ) { push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) ); } foreach my $loc ( @userSetLocations ) { push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); } # then update the user set_locations foreach ( @addSetLocations ) { my $Loc = $db->newUserSetLocation; $Loc->set_id( $setID ); $Loc->user_id( $userID ); $Loc->location_id($_); $db->addUserSetLocation($Loc); } foreach ( @delSetLocations ) { $db->deleteUserSetLocation($userID,$setID,$_); } } } else { # if override isn't selected, then we want # to be sure that there are no # set_locations_user entries setting around foreach my $record ( @userRecords ) { my $userID = $record->user_id; my @userLocations = $db->listUserSetLocations($userID,$setID); foreach ( @userLocations ) { $db->deleteUserSetLocation($userID,$setID,$_); } } } } else { foreach my $field ( @{ SET_FIELDS() } ) { next unless canChange($forUsers, $field); my $param = $r->param("set.$setID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; if ($field =~ /_date/) { $param = $self->parseDateTime($param) unless defined $unlabel; } if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby} && $param) { $param = $param*$properties{$field}->{convertby}; } # special case; does field fill in multiple values? if ( $field =~ /:/ ) { my @values = split(/:/, $param); my @fields = split(/:/, $field); for ( my $i=0; $i<@fields; $i++ ) { my $f = $fields[$i]; $setRecord->$f($values[$i]); } } else { $setRecord->$field($param); } } #################### # FIXME: this is replaced by our setting both hide_score and hide_score_by_problem # with a single drop down # # # a check for hiding scores: if we have # # $set->hide_score eq 'N', we also want # # $set->hide_score_by_problem eq 'N', and if it's # # changed to 'Y' and hide_score_by_problem is Null, # # give it a value 'N' # if ( $setRecord->hide_score eq 'N' || # ( ! defined($setRecord->hide_score_by_problem) || # $setRecord->hide_score_by_problem eq '' ) ) { # $setRecord->hide_score_by_problem('N'); # } #################### $db->putGlobalSet($setRecord); ####################################################### # Save IP restriction Location information ####################################################### if ( defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No' ) { my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); my @globalSetLocations = $db->listGlobalSetLocations($setID); my @addSetLocations = (); my @delSetLocations = (); foreach my $loc ( @selectedLocations ) { push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @globalSetLocations ) ); } foreach my $loc ( @globalSetLocations ) { push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); } # then update the global set_locations foreach ( @addSetLocations ) { my $Loc = $db->newGlobalSetLocation; $Loc->set_id( $setID ); $Loc->location_id($_); $db->addGlobalSetLocation($Loc); } foreach ( @delSetLocations ) { $db->deleteGlobalSetLocation($setID,$_); } } else { my @globalSetLocations = $db->listGlobalSetLocations($setID); foreach ( @globalSetLocations ) { $db->deleteGlobalSetLocation($setID,$_); } } ####################################################### # Save proctored problem proctor user information ####################################################### if ($r->param("set.$setID.restricted_login_proctor_password") && $setRecord->assignment_type eq 'proctored_gateway') { # in this case we're adding a set-level proctor # or updating the password my $procID = "set_id:$setID"; my $pass = $r->param("set.$setID.restricted_login_proctor_password"); # should we carefully check in this case that # the user and password exist? the code # in the add stanza is pretty careful to # be sure that there's a one-to-one # correspondence between the existence of # the user and the setting of the set # restricted_login_proctor field, so we # assume that just checking the latter # here is sufficient. if ( $setRecord->restricted_login_proctor eq 'Yes' ) { # in this case we already have a set # level proctor, and so should be # resetting the password if ( $pass ne '********' ) { # then we submitted a new # password, so save it my $dbPass; eval { $dbPass = $db->getPassword($procID) }; if ( $@ ) { $self->addbadmessage("Error getting old set-proctor password from the database: $@. No update to the password was done."); } else { $dbPass->password(cryptPassword($pass)); $db->putPassword($dbPass); } } } else { $setRecord->restricted_login_proctor('Yes'); my $procUser = $db->newUser(); $procUser->user_id($procID); $procUser->last_name("Proctor"); $procUser->first_name("Login"); $procUser->student_id("loginproctor"); $procUser->status($ce->status_name_to_abbrevs('Proctor')); my $procPerm = $db->newPermissionLevel; $procPerm->user_id($procID); $procPerm->permission($ce->{userRoles}->{login_proctor}); my $procPass = $db->newPassword; $procPass->user_id($procID); $procPass->password(cryptPassword($pass)); # put these into the database eval { $db->addUser($procUser) }; if ( $@ ) { $self->addbadmessage("Error " . "adding set-level " . "proctor: $@"); } else { $db->addPermissionLevel($procPerm); $db->addPassword($procPass); } # and set the restricted_login_proctor # set field $db->putGlobalSet( $setRecord ); } } else { # if the parameter isn't set, or if the assignment # type is not 'proctored_gateway', then we need to be # sure that there's no set-level proctor defined if ( $setRecord->restricted_login_proctor eq 'Yes' ) { $setRecord->restricted_login_proctor('No'); $db->deleteUser( "set_id:$setID" ); $db->putGlobalSet( $setRecord ); } } } ##################################################################### # Save problem information ##################################################################### # DBFIXME use a WHERE clause, iterator? my @problemIDs = sort { $a <=> $b } $db->listGlobalProblems($setID);; my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); foreach my $problemRecord (@problemRecords) { my $problemID = $problemRecord->problem_id; die "Global problem $problemID for set $setID not found." unless $problemRecord; if ($forUsers) { # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page # So we only need to make changes to the UserProblem record and only then if we are overriding a value # in the GlobalProblem record or for fields unique to the UserProblem record. my @userIDs = @editForUser; my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; # DBFIXME where clause? iterator? my @userProblemRecords = $db->getUserProblems(@userProblemIDs); foreach my $record (@userProblemRecords) { my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses foreach my $field ( @{ PROBLEM_FIELDS() } ) { next unless canChange($forUsers, $field); my $override = $r->param("problem.$problemID.$field.override"); if (defined $override && $override eq $field) { my $param = $r->param("problem.$problemID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; $changed ||= changed($record->$field, $param); $record->$field($param); } else { $changed ||= changed($record->$field, undef); $record->$field(undef); } } foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; $changed ||= changed($record->$field, $param); $record->$field($param); } $db->putUserProblem($record) if $changed; } } else { # Since we're editing for ALL set users, we will make changes to the GlobalProblem record. # We may also have instances where a field is unique to the UserProblem record but we want # all users to (at least initially) have the same value # this only edits a globalProblem record my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses foreach my $field ( @{ PROBLEM_FIELDS() } ) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; $changed ||= changed($problemRecord->$field, $param); $problemRecord->$field($param); } $db->putGlobalProblem($problemRecord) if $changed; # sometimes (like for status) we might want to change an attribute in # the userProblem record for every assigned user # However, since this data is stored in the UserProblem records, # it won't be displayed once its been changed and if you hit "Save Changes" again # it gets erased # So we'll enforce that there be something worth putting in all the UserProblem records # This also will make hitting "Save Changes" on the global page MUCH faster my %useful; foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { my $param = $r->param("problem.$problemID.$field"); $useful{$field} = 1 if defined $param and $param ne ""; } if (keys %useful) { # DBFIXME where clause, iterator my @userIDs = $db->listProblemUsers($setID, $problemID); my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; my @userProblemRecords = $db->getUserProblems(@userProblemIDs); foreach my $record (@userProblemRecords) { my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses foreach my $field ( keys %useful ) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); $param = $properties{$field}->{default} || "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; $changed ||= changed($record->$field, $param); $record->$field($param); } $db->putUserProblem($record) if $changed; } } } } # Mark the specified problems as correct for all users foreach my $problemID ($r->param('markCorrect')) { # DBFIXME where clause, iterator my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID)); my @userProblemRecords = $db->getUserProblems(@userProblemIDs); foreach my $record (@userProblemRecords) { if (defined $record && ($record->status eq "" || $record->status < 1)) { $record->status(1); $record->attempted(1); $db->putUserProblem($record); } } } # Delete all problems marked for deletion foreach my $problemID ($r->param('deleteProblem')) { $db->deleteGlobalProblem($setID, $problemID); } ##################################################################### # Add blank problem if needed ##################################################################### if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { # get number of problems to add and clean the entry my $newBlankProblems = (defined($r->param("add_n_problems")) ) ? $r->param("add_n_problems") :1; $newBlankProblems = int($newBlankProblems); my $MAX_NEW_PROBLEMS = 20; if ($newBlankProblems >=1 and $newBlankProblems <= $MAX_NEW_PROBLEMS ) { foreach my $newProb (1..$newBlankProblems) { my $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setID)); ################################################## # make local copy of the blankProblem ################################################## my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; my $problemContents = WeBWorK::Utils::readFile($blank_file_path); my $new_file_path = "set$setID/".BLANKPROBLEM(); my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); local(*TEMPFILE); open(TEMPFILE, ">$fullPath") or warn "Can't write to file $fullPath"; print TEMPFILE $problemContents; close(TEMPFILE); ################################################# # Update problem record ################################################# my $problemRecord = $self->addProblemToSet( setName => $setID, sourceFile => $new_file_path, problemID => $targetProblemNumber, #added to end of set ); $self->assignProblemToAllSetUsers($problemRecord); $self->addgoodmessage("Added $new_file_path to ". $setID. " as problem $targetProblemNumber") ; } } else { $self->addbadmessage("Could not add $newBlankProblems problems to this set. The number must be between 1 and $MAX_NEW_PROBLEMS"); } } # Sets the specified header to "" so that the default file will get used. foreach my $header ($r->param('defaultHeader')) { $setRecord->$header(""); } } # Leftover code from when there were up/down buttons # } else { # # Look for up and down buttons # my $index = 2; # while ($index <= scalar @problemList) { # if (defined $r->param("move.up.$index.x")) { # moveme($index-1, $db, $setID, @problemList); # } # $index++; # } # $index = 1; # # while ($index < scalar @problemList) { # if (defined $r->param("move.down.$index.x")) { # moveme($index, $db, $setID, @problemList); # } # $index++; # } # } # This erases any sticky fields if the user saves changes, resets the form, or reorders problems # It may not be obvious why this is necessary when saving changes or reordering problems # but when the problems are reorder the param problem.1.source_file needs to be the source # file of the problem that is NOW #1 and not the problem that WAS #1. unless (defined $r->param('refresh')) { # reset all the parameters dealing with set/problem/header information # if the current naming scheme is changed/broken, this could reek havoc # on all kinds of things foreach my $param ($r->param) { $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; } } } # helper method for debugging sub definedness ($) { my ($variable) = @_; return "undefined" unless defined $variable; return "empty" unless $variable ne ""; return $variable; } # helper method for checking if two things are different # the return values will usually be thrown away, but they could be useful for debugging sub changed ($$) { my ($first, $second) = @_; return "def/undef" if defined $first and not defined $second; return "undef/def" if not defined $first and defined $second; return "" if not defined $first and not defined $second; return "ne" if $first ne $second; return ""; # if they're equal, there's no change } # helper method that determines for how many users at a time a field can be changed # none means it can't be changed for anyone # any means it can be changed for anyone # one means it can ONLY be changed for one at a time. (eg problem_seed) # all means it can ONLY be changed for all at a time. (eg set_header) sub canChange ($$) { my ($forUsers, $field) = @_; my %properties = %{ FIELD_PROPERTIES() }; my $forOneUser = $forUsers == 1; my $howManyCan = $properties{$field}->{override}; return 0 if $howManyCan eq "none"; return 1 if $howManyCan eq "any"; return 1 if $howManyCan eq "one" && $forOneUser; return 1 if $howManyCan eq "all" && !$forUsers; return 0; # FIXME: maybe it should default to 1? } # helper method that determines if a file is valid and returns a pretty error message sub checkFile ($) { my ($self, $file) = @_; my $r = $self->r; my $ce = $r->ce; return "No source file specified" unless $file; $file = $ce->{courseDirs}->{templates} . '/' . $file unless $file =~ m|^/|; my $text = "This source file "; my $fileError; return "" if -e $file && -f $file && -r $file; return $text . "is not readable!" if -e $file && -f $file; return $text . "is a directory!" if -d $file; return $text . "does not exist!" unless -e $file; return $text . "is not a plain file!"; } # don't show view options -- we provide display mode controls for headers/problems separately sub options { return ""; } # Creates two separate tables, first of the headers, and the of the problems in a given set # If one or more users are specified in the "editForUser" param, only the data for those users # becomes editable, not all the data sub body { my ($self) = @_; my $r = $self->r; my $db = $r->db; my $ce = $r->ce; my $authz = $r->authz; my $userID = $r->param('user'); my $urlpath = $r->urlpath; my $courseID = $urlpath->arg("courseID"); my $setID = $urlpath->arg("setID"); my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID."; my $userRecord = $db->getUser($userID) or die "No record for user $userID."; # Check permissions return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($userRecord->user_id, "access_instructor_tools"); return CGI::div({class=>"ResultsWithError"}, "You are not authorized to modify problems.") unless $authz->hasPermissions($userRecord->user_id, "modify_problem_sets"); my @editForUser = $r->param('editForUser'); # Check that every user that we're editing for has a valid UserSet my @assignedUsers; my @unassignedUsers; if (scalar @editForUser) { foreach my $ID (@editForUser) { # DBFIXME iterator if ($db->getUserSet($ID, $setID)) { unshift @assignedUsers, $ID; } else { unshift @unassignedUsers, $ID; } } @editForUser = sort @assignedUsers; $r->param("editForUser", \@editForUser); if (scalar @editForUser && scalar @unassignedUsers) { print CGI::div({class=>"ResultsWithError"}, "The following users are NOT assigned to this set and will be ignored: " . CGI::b(join(", ", @unassignedUsers))); } elsif (scalar @editForUser == 0) { print CGI::div({class=>"ResultsWithError"}, "None of the selected users are assigned to this set: " . CGI::b(join(", ", @unassignedUsers))); print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data"); } } # some useful booleans my $forUsers = scalar(@editForUser); my $forOneUser = $forUsers == 1; # If you're editing for users, initially their records will be different but # if you make any changes to them they will be the same. # if you're editing for one user, the problems shown should be his/hers my $userToShow = $forUsers ? $editForUser[0] : $userID; # DBFIXME no need to get ID lists -- counts would be fine my $userCount = $db->listUsers(); my $setCount = $db->listGlobalSets(); # if $forOneUser; my $setUserCount = $db->countSetUsers($setID); my $userSetCount = $db->countUserSets($editForUser[0]) if $forOneUser; my $editUsersAssignedToSetURL = $self->systemLink( $urlpath->newFromModule( "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", courseID => $courseID, setID => $setID)); my $editSetsAssignedToUserURL = $self->systemLink( $urlpath->newFromModule( "WeBWorK::ContentGenerator::Instructor::UserDetail", courseID => $courseID, userID => $editForUser[0])) if $forOneUser; my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID); my $setDetailURL = $self->systemLink($setDetailPage, authen=>0); my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount)); my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser; $userCountMessage = "The set $setID is assigned to " . $userCountMessage . "."; $setCountMessage = "The user $editForUser[0] has been assigned " . $setCountMessage . "." if $forOneUser; if ($forUsers) { ############################################## # calculate links for the users being edited: ############################################## my @userLinks = (); foreach my $userID (@editForUser) { my $u = $db->getUser($userID); my $email_address = $u->email_address; my $line = $u->last_name.", ".$u->first_name."  (".CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id."). Assigned to "; my $editSetsAssignedToUserURL = $self->systemLink( $urlpath->newFromModule( "WeBWorK::ContentGenerator::Instructor::UserDetail", courseID => $courseID, userID => $u->user_id)); $line .= CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($db->countUserSets($u->user_id), $setCount)); unshift @userLinks,$line; } @userLinks = sort @userLinks; print CGI::table({border=>2,cellpadding=>10}, CGI::Tr({}, CGI::td([ "Editing problem set ".CGI::strong($setID)." data for these individual students:".CGI::br(). CGI::strong(join CGI::br(), @userLinks), CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set."), ]) ) ); } else { print CGI::table({border=>2,cellpadding=>10}, CGI::Tr({}, CGI::td([ "This set ".CGI::strong($setID)." is assigned to ".$self->userCountMessage($setUserCount, $userCount).'.' , 'Edit '.CGI::a({href=>$editUsersAssignedToSetURL},'individual versions '). "of set $setID.", ]) ) ); } # handle renumbering of problems if necessary print CGI::a({name=>"problems"}); my %newProblemNumbers = (); my $maxProblemNumber = -1; for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { $newProblemNumbers{$jj} = $r->param('problem_num_' . $jj); $maxProblemNumber = $jj if $jj > $maxProblemNumber; } my $forceRenumber = $r->param('force_renumber') || 0; handle_problem_numbers(\%newProblemNumbers, $maxProblemNumber, $db, $setID, $forceRenumber) unless defined $r->param('undo_changes'); my %properties = %{ FIELD_PROPERTIES() }; my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; push @active_modes, 'None'; my $default_header_mode = $r->param('header.displaymode') || 'None'; my $default_problem_mode = $r->param('problem.displaymode') || 'None'; ##################################################################### # Browse available header/problem files ##################################################################### my $templates = $r->ce->{courseDirs}->{templates}; my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); my @headerFileList = listFilesRecursive( $templates, qr/header.*\.pg$/i, # match these files qr/^(?:$skip|CVS)$/, # prune these directories 0, # match against file name only 1, # prune against path relative to $templates ); # this just takes too much time to search # my @problemFileList = listFilesRecursive( # $templates, # qr/\.pg$/i, # problem files don't say problem # qr/^(?:$skip|CVS)$/, # prune these directories # 0, # match against file name only # 1, # prune against path relative to $templates # ); # Display a useful warning message if ($forUsers) { print CGI::p(CGI::b("Any changes made below will be reflected in the set for ONLY the student" . ($forOneUser ? "" : "s") . " listed above.")); } else { print CGI::p(CGI::b("Any changes made below will be reflected in the set for ALL students.")); } print CGI::start_form({method=>"POST", action=>$setDetailURL}); print $self->hiddenEditForUserFields(@editForUser); print $self->hidden_authen_fields; print CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}); print CGI::input({type=>"submit", name=>"undo_changes", value => "Reset Form"}); # spacing print CGI::p(); ##################################################################### # Display general set information ##################################################################### print CGI::start_table({border=>1, cellpadding=>4}); print CGI::Tr({}, CGI::th({}, [ "General Information", ])); # this is kind of a hack -- we need to get a user record here, so we can # pass it to FieldTable, so FieldTable can pass it to FieldHTML, so # FieldHTML doesn't have to fetch it itself. my $userSetRecord = $db->getUserSet($userToShow, $setID); print CGI::Tr({}, CGI::td({}, [ $self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord), ])); print CGI::end_table(); # spacing print CGI::p(); ##################################################################### # Display header information ##################################################################### my @headers = @{ HEADER_ORDER() }; my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); my @headerFiles = map { $setRecord->{$_} } @headers; if (scalar @headers and not $forUsers) { print CGI::start_table({border=>1, cellpadding=>4}); print CGI::Tr({}, CGI::th({}, [ "Headers", # "Data", "Display Mode: " . CGI::popup_menu(-name => "header.displaymode", -values => \@active_modes, -default => $default_header_mode) . ' '. CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), ])); my %header_html; my %error; my $this_set = $db->getMergedSet($userToShow, $setID); my $guaranteed_set = $this_set; if ( ! $guaranteed_set ) { # in the header loop we need to have a set that # we know exists, so if the getMergedSet failed # (that is, the set isn't assigned to the # the current user), we get the global set instead $guaranteed_set = $db->getGlobalSet( $setID ); } foreach my $header (@headers) { my $headerFile = $r->param("set.$setID.$header") || $setRecord->{$header} || $headerDefaults{$header}; $error{$header} = $self->checkFile($headerFile); unless ($error{$header}) { my @temp = renderProblems( r=> $r, user => $db->getUser($userToShow), displayMode=> $default_header_mode, problem_number=> 0, this_set => $this_set, problem_list => [$headerFile], ); $header_html{$header} = $temp[0]; } } foreach my $header (@headers) { my $editHeaderPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 }); my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $header, make_local_copy => 1 }); my $viewHeaderPage = $urlpath->new(type => $headerModules{$header}, args => { courseID => $courseID, setID => $setID }); my $viewHeaderLink = $self->systemLink($viewHeaderPage); # this is a bit of a hack; the set header isn't shown # for gateway tests, and we run into trouble trying to # edit/view it in this context, so we don't show this # field for gateway tests if ( $header eq 'set_header' && $guaranteed_set->assignment_type =~ /gateway/ ) { print CGI::Tr({}, CGI::td({}, [ "Set Header", "Set headers are not used in " . "display of gateway tests."])); next; } print CGI::Tr({}, CGI::td({}, [ CGI::start_table({border => 0, cellpadding => 0}) . CGI::Tr({}, CGI::td({}, $properties{$header}->{name})) . CGI::Tr({}, CGI::td({}, CGI::a({href => $editHeaderLink, target=>"WW_Editor"}, "Edit it"))) . CGI::Tr({}, CGI::td({}, CGI::a({href => $viewHeaderLink, target=>"WW_View"}, "View it"))) . # CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "defaultHeader", value => $header, label => "Use Default"}))) . CGI::end_table(), # "", # CGI::input({ name => "set.$setID.$header", value => $setRecord->{$header}, size => 50}) . # join ("\n", $self->FieldHTML($userToShow, $setID, $problemID, "source_file")) . # CGI::br() . CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}), comboBox({ name => "set.$setID.$header", request => $r, default => $r->param("set.$setID.$header") || $setRecord->{$header}, multiple => 0, values => ["", @headerFileList], labels => { "" => "Use Default Header File" }, }) . ($error{$header} ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error{$header}) : CGI::div({class=> "RenderSolo"}, $header_html{$header}->{body_text}) ), ])); } print CGI::end_table(); } else { print CGI::p(CGI::b("Screen and Hardcopy set header information can not be overridden for individual students.")); } # spacing print CGI::p(); ##################################################################### # Display problem information ##################################################################### my @problemIDList = sort { $a <=> $b } $db->listGlobalProblems($setID); # DBFIXME use iterators instead of getting all at once # get global problem records for all problems in one go my %GlobalProblems; my @globalKeypartsRef = map { [$setID, $_] } @problemIDList; # DBFIXME shouldn't need to get key list here @GlobalProblems{@problemIDList} = $db->getGlobalProblems(@globalKeypartsRef); # if needed, get user problem records for all problems in one go my (%UserProblems, %MergedProblems); if ($forOneUser) { my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList; # DBFIXME shouldn't need to get key list here @UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef); @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef); } if (scalar @problemIDList) { print CGI::start_table({border=>1, cellpadding=>4}); print CGI::Tr({}, CGI::th({}, [ "Problems", "Data", "Display Mode: " . CGI::popup_menu(-name => "problem.displaymode", -values => \@active_modes, -default => $default_problem_mode) . ' '. CGI::input({type => "submit", name => "refresh", value => "Refresh Display"}), ])); my %shownYet; my $repeatFile; foreach my $problemID (@problemIDList) { my $problemRecord; if ($forOneUser) { #$problemRecord = $db->getMergedProblem($editForUser[0], $setID, $problemID); $problemRecord = $MergedProblems{$problemID}; # already fetched above --sam } else { #$problemRecord = $db->getGlobalProblem($setID, $problemID); $problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam } #$self->addgoodmessage(""); #$self->addbadmessage($problemRecord->toString()); my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); my $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); # FIXME: should we have an "act as" type link here when editing for multiple users? my $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID }); my $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)}); my @fields = @{ PROBLEM_FIELDS() }; push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser; my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file; # warn of repeat problems if (defined $shownYet{$problemFile}) { $repeatFile = "This problem uses the same source file as number " . $shownYet{$problemFile} . "."; } else { $shownYet{$problemFile} = $problemID; $repeatFile = ""; } my $error = $self->checkFile($problemFile); my $this_set = $db->getMergedSet($userToShow, $setID); my @problem_html; unless ($error) { @problem_html = renderProblems( r=> $r, user => $db->getUser($userToShow), displayMode=> $default_problem_mode, problem_number=> $problemID, this_set => $this_set, problem_seed => $forOneUser ? $problemRecord->problem_seed : 0, problem_list => [$problemRecord->source_file], ); } print CGI::Tr({}, CGI::td({}, [ CGI::start_table({border => 0, cellpadding => 1}) . CGI::Tr({}, CGI::td({}, problem_number_popup($problemID, $maxProblemNumber))) . CGI::Tr({}, CGI::td({}, CGI::a({href => $editProblemLink, target=>"WW_Editor"}, "Edit it"))) . CGI::Tr({}, CGI::td({}, CGI::a({href => $viewProblemLink, target=>"WW_View"}, "Try it" . ($forOneUser ? " (as $editForUser[0])" : "")))) . ($forUsers ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "deleteProblem", value => $problemID, label => "Delete it?"})))) . # CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) . ($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) . CGI::end_table(), $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}), # A comprehensive list of problems is just TOO big to be handled well # comboBox({ # name => "set.$setID.$problemID", # request => $r, # default => $problemRecord->{problem_id}, # multiple => 0, # values => \@problemFileList, # }) . join ("\n", $self->FieldHTML( $userToShow, $setID, $problemID, $GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam $UserProblems{$problemID}, # pass previously fetched user record to FieldHTML --sam "source_file" )) . CGI::br() . ($error ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $error) : CGI::div({class=> "RenderSolo"}, $problem_html[0]->{body_text}) ) . ($repeatFile ? CGI::div({class=>"ResultsWithError", style=>"font-weight: bold"}, $repeatFile) : ''), ])); } # print final lines print CGI::end_table(); print CGI::checkbox({ label=> "Force problems to be numbered consecutively from one (always done when reordering problems)", name=>"force_renumber", value=>"1"}); print CGI::p(<open_date>time()); print CGI::p("When changing problem numbers, we will move the problem to be ". CGI::em("before"). " the chosen number."); } else { print CGI::p(CGI::b("This set doesn't contain any problems yet.")); } # always allow one to add a new problem. print CGI::checkbox({ label=> "Add", name=>"add_blank_problem", value=>"1"} ),CGI::input({ name=>"add_n_problems", size=>2, value=>1 }, "blank problem template(s) to end of homework set" ), CGI::br(),CGI::br(), CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}), CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}), "(Any unsaved changes will be lost.)" ; #my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' }); #my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' }); # This next feature isn't fully supported and is causing problems. Remove for now. #FIXME #print CGI::p( CGI::a({href=>$editNewProblemLink},'Edit'). ' a new blank problem'); print CGI::end_form(); return ""; } 1; =head1 AUTHOR Written by Robert Van Dam, toenail (at) cif.rochester.edu =cut