From 7d0cc852b05fd7909eb423b8ea7bafbd1f32c113 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 2 Jan 2023 19:03:30 -0600 Subject: [PATCH] Set definition file handling improvements. The set definition utility methods in ProblemSetList.pm have been moved into a separate file. The new file is `lib/WeBWorK/File/SetDef.pm`. The methods in this file do the same things that the previous methods in `lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm` with some improvements. This separates the set definition file handling from the content generator user interface code. The `readSetDef` no long returns a reference to a messy array of disorganized data. Instead it returns a reference to a hash whose keys give information as to what the data fields are. Using this hash in the method itself also facilitates a much cleaner way to extract the data from a set definition file than the massive `if .. elsif ..` mess from before. Note that if dates are out of order, instead of just leaving them and warning about it, the defaults relative to the due date are used just as they would be when creating a new set. If the due date is not defined, then one week from the current time be used. The messages about these dates being out of order in the file are still shown though. Another big improvement is that `warn` is never used in the file. Instead any of those previous warnings are returned in a reference to an array. Each element of the array is also an array reference whose contents are suitable for passing to maketext. This is one of the needed steps toward removing the global warning handler. To accommodate more complex warning messages the `addgoodmessage` and `addbadmessage` methods need to be placed in a `div` container with the "alert" role instead of a `p`. Visibly this makes no difference. Using this the warnings from before are now in the alert messages returned from the SetDef.pm methods. --- htdocs/themes/math4/math4.scss | 2 +- lib/WeBWorK/ContentGenerator.pm | 6 +- .../Instructor/ProblemSetList.pm | 879 +----------------- lib/WeBWorK/File/SetDef.pm | 789 ++++++++++++++++ .../ProblemSetList/import_form.html.ep | 2 +- 5 files changed, 830 insertions(+), 848 deletions(-) create mode 100644 lib/WeBWorK/File/SetDef.pm diff --git a/htdocs/themes/math4/math4.scss b/htdocs/themes/math4/math4.scss index f0fee9b40f..87494e47b8 100644 --- a/htdocs/themes/math4/math4.scss +++ b/htdocs/themes/math4/math4.scss @@ -456,7 +456,7 @@ h2.page-title { gap: 0.25rem; margin: 0 0 0.5rem; - p { + div { margin: 0; } } diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 9c0d7dad01..992597c747 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -265,8 +265,9 @@ message() template escape handler. sub addgoodmessage ($c, $message) { $c->addmessage($c->tag( - 'p', + 'div', class => 'alert alert-success alert-dismissible fade show ps-1 py-1', + role => 'alert', $c->c( $message, $c->tag( @@ -290,8 +291,9 @@ message() template escape handler. sub addbadmessage ($c, $message) { $c->addmessage($c->tag( - 'p', + 'div', class => 'alert alert-danger alert-dismissible fade show ps-1 py-1', + role => 'alert', $c->c( $message, $c->tag( diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index 903e2df08d..076370411a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -78,14 +78,12 @@ Delete sets: use Mojo::File; use WeBWorK::Debug; -use WeBWorK::Utils qw(timeToSec listFilesRecursive jitar_id_to_seq seq_to_jitar_id x - format_set_name_internal format_set_name_display); -use WeBWorK::Utils::Instructor qw(assignSetToUser assignSetToAllUsers addProblemToSet); +use WeBWorK::Utils qw(x format_set_name_internal format_set_name_display); +use WeBWorK::Utils::Instructor qw(assignSetToUser); +use WeBWorK::File::SetDef qw(importSetsFromDef exportSetsToDef); -use constant HIDE_SETS_THRESHOLD => 500; -use constant DEFAULT_VISIBILITY_STATE => 1; -use constant DEFAULT_ENABLED_REDUCED_SCORING_STATE => 0; -use constant ONE_WEEK => 60 * 60 * 24 * 7; +use constant HIDE_SETS_THRESHOLD => 500; +use constant ONE_WEEK => 60 * 60 * 24 * 7; use constant EDIT_FORMS => [qw(save_edit cancel_edit)]; use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)]; @@ -474,8 +472,8 @@ sub create_handler ($c) { $newSetRecord->reduced_scoring_date($dueDate - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}); $newSetRecord->due_date($dueDate); $newSetRecord->answer_date($dueDate + 60 * $ce->{pg}{answersOpenAfterDueDate}); - $newSetRecord->visible(DEFAULT_VISIBILITY_STATE()); # don't want students to see an empty set - $newSetRecord->enable_reduced_scoring(DEFAULT_ENABLED_REDUCED_SCORING_STATE()); + $newSetRecord->visible(1); # don't want students to see an empty set + $newSetRecord->enable_reduced_scoring(0); $newSetRecord->assignment_type('default'); $db->addGlobalSet($newSetRecord); } elsif ($type eq "copy") { @@ -533,28 +531,29 @@ sub create_handler ($c) { } sub import_handler ($c) { - my ($added, $skipped) = $c->importSetsFromDef( - $c->param('action.import.number') > 1 - ? '' # Cannot assign set names to multiple imports. - : format_set_name_internal($c->param('action.import.name')), + my ($added, $skipped, $errors) = importSetsFromDef( + $c->ce, + $c->db, + [ $c->param('action.import.source') ], + $c->{allSetIDs}, $c->param('action.import.assign'), $c->param('action.import.start.date') // 0, - $c->param('action.import.source') + # Cannot assign set names to multiple imports. + $c->param('action.import.number') > 1 ? '' : format_set_name_internal($c->param('action.import.name')), ); # Make new sets visible. push @{ $c->{visibleSetIDs} }, @$added; push @{ $c->{allSetIDs} }, @$added; - my $numAdded = @$added; - my $numSkipped = @$skipped; - return ( - 1, - $c->maketext( - '[_1] sets added, [_2] sets skipped. Skipped sets: ([_3])', $numAdded, - $numSkipped, join(', ', @$skipped) - ) + @$skipped ? 0 : 1, + $c->c( + $c->maketext('[quant,_1,set] added, [quant,_2,set] skipped.', scalar(@$added), scalar(@$skipped)), + @$errors + ? $c->tag('ul', class => 'my-1', $c->c(map { $c->tag('li', $c->maketext(@$_)) } @$errors)->join('')) + : '' + )->join('') ); } @@ -592,32 +591,27 @@ sub cancel_export_handler ($c) { } sub save_export_handler ($c) { - my @setIDsToExport = @{ $c->{selectedSetIDs} }; - - my %filenames = map { $_ => ($c->param("set.$_") || $_) } @setIDsToExport; + my ($exported, $skipped, $reason) = + exportSetsToDef($c->ce, $c->db, @{ $c->{selectedSetIDs} }); - my ($exported, $skipped, $reason) = $c->exportSetsToDef(%filenames); - - if (defined $c->param("prev_visible_sets")) { - $c->{visibleSetIDs} = [ $c->param("prev_visible_sets") ]; - } elsif (defined $c->param("no_prev_visble_sets")) { + if (defined $c->param('prev_visible_sets')) { + $c->{visibleSetIDs} = [ $c->param('prev_visible_sets') ]; + } elsif (defined $c->param('no_prev_visble_sets')) { $c->{visibleSetIDs} = []; } $c->{exportMode} = 0; - my $numExported = @$exported; - my $numSkipped = @$skipped; - - my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason; - return ( - !$numSkipped, - $c->b($c->maketext( - '[_1] sets exported, [_2] sets skipped. Skipped sets: ([_3])', - $numExported, $numSkipped, - $numSkipped ? $c->tag('ul', $c->c(map { $c->tag('li', $_) } @reasons)->join('')) : '' - )) + @$skipped ? 0 : 1, + $c->c( + $c->maketext('[quant,_1,set] exported, [quant,_2,set] skipped.', scalar(@$exported), scalar(@$skipped)), + @$skipped ? $c->tag( + 'ul', + class => 'my-1', + $c->c(map { $c->tag('li', "set $_ - " . $c->maketext(@{ $reason->{$_} })) } keys %$reason)->join('') + ) : '' + )->join('') ); } @@ -723,807 +717,4 @@ sub save_edit_handler ($c) { return (1, $c->maketext("changes saved")); } -# Utilities - -sub importSetsFromDef ($c, $newSetName, $assign, $startdate, @setDefFiles) { - my $ce = $c->ce; - my $db = $c->db; - my $dir = $ce->{courseDirs}{templates}; - my $mindate = 0; - - # If the user includes "following files" in a multiple selection - # it shows up here as "" which causes the importing to die. - # So, we select on filenames containing non-whitespace. - @setDefFiles = grep {/\S/} @setDefFiles; - - # FIXME: do we really want everything to fail on one bad file name? - foreach my $fileName (@setDefFiles) { - die $c->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) - unless -r "$dir/$fileName"; - } - - # Get a list of set ids of existing sets in the course. This is used to - # ensure that an imported set does not already exist. - my %allSets = map { $_ => 1 } @{ $c->{allSetIDs} }; - - my (@added, @skipped); - - foreach my $set_definition_file (@setDefFiles) { - - debug("$set_definition_file: reading set definition file"); - # read data in set definition file - my ( - $setName, $paperHeaderFile, $screenHeaderFile, $openDate, - $dueDate, $answerDate, $ra_problemData, $assignmentType, - $enableReducedScoring, $reducedScoringDate, $attemptsPerVersion, $timeInterval, - $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, - $hideScore, $hideScoreByProblem, $hideWork, $timeCap, - $restrictIP, $restrictLoc, $relaxRestrictIP, $description, - $emailInstructor, $restrictProbProgression - ) = $c->readSetDef($set_definition_file); - my @problemList = @{$ra_problemData}; - - # Use the original name if form doesn't specify a new one. - # The set acquires the new name specified by the form. A blank - # entry on the form indicates that the imported set name will be used. - $setName = $newSetName if $newSetName; - - if ($allSets{$setName}) { - # this set already exists!! - push @skipped, $setName; - next; - } else { - push @added, $setName; - } - - # keep track of which as the earliest answer date - if ($mindate > $openDate || $mindate == 0) { - $mindate = $openDate; - } - - debug("$set_definition_file: adding set"); - # add the data to the set record - my $newSetRecord = $db->newGlobalSet; - $newSetRecord->set_id($setName); - $newSetRecord->set_header($screenHeaderFile); - $newSetRecord->hardcopy_header($paperHeaderFile); - $newSetRecord->open_date($openDate); - $newSetRecord->due_date($dueDate); - $newSetRecord->answer_date($answerDate); - $newSetRecord->visible(DEFAULT_VISIBILITY_STATE); - $newSetRecord->reduced_scoring_date($reducedScoringDate); - $newSetRecord->enable_reduced_scoring($enableReducedScoring); - $newSetRecord->description($description); - $newSetRecord->email_instructor($emailInstructor); - $newSetRecord->restrict_prob_progression($restrictProbProgression); - - # gateway/version data. these should are all initialized to '' - # by readSetDef, so for non-gateway/versioned sets they'll just - # be stored as null - $newSetRecord->assignment_type($assignmentType); - $newSetRecord->attempts_per_version($attemptsPerVersion); - $newSetRecord->time_interval($timeInterval); - $newSetRecord->versions_per_interval($versionsPerInterval); - $newSetRecord->version_time_limit($versionTimeLimit); - $newSetRecord->problem_randorder($problemRandOrder); - $newSetRecord->problems_per_page($problemsPerPage); - $newSetRecord->hide_score($hideScore); - $newSetRecord->hide_score_by_problem($hideScoreByProblem); - $newSetRecord->hide_work($hideWork); - $newSetRecord->time_limit_cap($timeCap); - $newSetRecord->restrict_ip($restrictIP); - $newSetRecord->relax_restrict_ip($relaxRestrictIP); - - #create the set - eval { $db->addGlobalSet($newSetRecord) }; - die $c->maketext("addGlobalSet [_1] in ProblemSetList: [_2]", $setName, $@) if $@; - - #do we need to add locations to the set_locations table? - if ($restrictIP ne 'No' && $restrictLoc) { - if ($db->existsLocation($restrictLoc)) { - if (!$db->existsGlobalSetLocation($setName, $restrictLoc)) { - my $newSetLocation = $db->newGlobalSetLocation; - $newSetLocation->set_id($setName); - $newSetLocation->location_id($restrictLoc); - eval { $db->addGlobalSetLocation($newSetLocation) }; - warn($c->maketext( - "error adding set location [_1] for set [_2]: [_3]", - $restrictLoc, $setName, $@ - )) - if $@; - } else { - # this should never happen. - warn( - $c->maketext( - "input set location [_1] already exists for set [_2].", $restrictLoc, $setName - ) - . "\n" - ); - } - } else { - warn( - $c->maketext("restriction location [_1] does not exist. IP restrictions have been ignored.", - $restrictLoc) - . "\n" - ); - $newSetRecord->restrict_ip('No'); - $newSetRecord->relax_restrict_ip('No'); - eval { $db->putGlobalSet($newSetRecord) }; - # we ignore error messages here; if the set - # added without error before, we assume - # (ha) that it will put without trouble - } - } - - debug("$set_definition_file: adding problems to database"); - # add problems - my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; - foreach my $rh_problem (@problemList) { - addProblemToSet( - $db, $ce->{problemDefaults}, - setName => $setName, - sourceFile => $rh_problem->{source_file}, - problemID => $rh_problem->{problemID} ? $rh_problem->{problemID} : $freeProblemID++, - value => $rh_problem->{value}, - maxAttempts => $rh_problem->{max_attempts}, - showMeAnother => $rh_problem->{showMeAnother}, - showHintsAfter => $rh_problem->{showHintsAfter}, - prPeriod => $rh_problem->{prPeriod}, - attToOpenChildren => $rh_problem->{attToOpenChildren}, - countsParentGrade => $rh_problem->{countsParentGrade} - ); - } - - if ($assign eq "all") { - assignSetToAllUsers($db, $ce, $setName); - } else { - my $userName = $c->param('user'); - assignSetToUser($db, $userName, $newSetRecord); ## always assign set to instructor - } - } - - #if there is a start date we have to reopen all of the sets that were added and shift the dates - if ($startdate) { - #the shift for all of the dates is from the min date to the start date - my $dateshift = $startdate - $mindate; - - foreach my $setID (@added) { - my $setRecord = $db->getGlobalSet($setID); - $setRecord->open_date($setRecord->open_date + $dateshift); - $setRecord->reduced_scoring_date($setRecord->reduced_scoring_date + $dateshift); - $setRecord->due_date($setRecord->due_date + $dateshift); - $setRecord->answer_date($setRecord->answer_date + $dateshift); - $db->putGlobalSet($setRecord); - } - } - - return \@added, \@skipped; -} - -sub readSetDef ($c, $fileName) { - my $ce = $c->ce; - my $templateDir = $ce->{courseDirs}{templates}; - my $filePath = "$templateDir/$fileName"; - my $weight_default = $ce->{problemDefaults}{value}; - my $max_attempts_default = $ce->{problemDefaults}{max_attempts}; - my $att_to_open_children_default = $ce->{problemDefaults}{att_to_open_children}; - my $counts_parent_grade_default = $ce->{problemDefaults}{counts_parent_grade}; - my $showMeAnother_default = $ce->{problemDefaults}{showMeAnother}; - my $showHintsAfter_default = $ce->{problemDefaults}{showHintsAfter}; - my $prPeriod_default = $ce->{problemDefaults}{prPeriod}; - - my $setName = ''; - - if ($fileName =~ m|^(.*/)?set([.\w-]+)\.def$|) { - $setName = $2; - } else { - $c->addbadmessage( - qq{The setDefinition file name must begin with set and must end with }, - qq{.def. Every thing in between becomes the name of the set. For example }, - qq{set1.def, setExam.def, and setsample7.def define }, - qq{sets named 1, Exam, and sample7 respectively. }, - qq{The filename "$fileName" you entered is not legal\n } - ); - - } - - my ($name, $weight, $attemptLimit, $continueFlag); - my $paperHeaderFile = ''; - my $screenHeaderFile = ''; - my $description = ''; - my ($dueDate, $openDate, $reducedScoringDate, $answerDate); - my @problemData; - - # added fields for gateway test/versioned set definitions: - my ( - $assignmentType, $attemptsPerVersion, $timeInterval, $enableReducedScoring, - $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, - $restrictLoc, $emailInstructor, $restrictProbProgression, $countsParentGrade, - $attToOpenChildren, $problemID, $showMeAnother, $showHintsAfter, - $prPeriod, $listType - ) = ('') x 18; # initialize these to '' - my ($timeCap, $restrictIP, $relaxRestrictIP) = (0, 'No', 'No'); - # additional fields currently used only by gateways; later, the world? - my ($hideScore, $hideScoreByProblem, $hideWork,) = ('N', 'N', 'N'); - - my %setInfo; - if (my $SETFILENAME = Mojo::File->new($filePath)->open('<')) { - # Read and check set data - while (my $line = <$SETFILENAME>) { - - chomp $line; - $line =~ s|(#.*)||; # Don't read past comments - unless ($line =~ /\S/) { next; } # Skip blank lines - $line =~ s|\s*$||; # Trim trailing spaces - $line =~ m|^\s*(\w+)\s*=?\s*(.*)|; - - # Sanity check entries - my $item = $1; - $item = '' unless defined $item; - my $value = $2; - $value = '' unless defined $value; - - if ($item eq 'setNumber') { - next; - } elsif ($item eq 'paperHeaderFile') { - $paperHeaderFile = $value; - } elsif ($item eq 'screenHeaderFile') { - $screenHeaderFile = $value; - } elsif ($item eq 'dueDate') { - $dueDate = $value; - } elsif ($item eq 'openDate') { - $openDate = $value; - } elsif ($item eq 'answerDate') { - $answerDate = $value; - } elsif ($item eq 'enableReducedScoring') { - $enableReducedScoring = $value; - } elsif ($item eq 'reducedScoringDate') { - $reducedScoringDate = $value; - } elsif ($item eq 'assignmentType') { - $assignmentType = $value; - } elsif ($item eq 'attemptsPerVersion') { - $attemptsPerVersion = $value; - } elsif ($item eq 'timeInterval') { - $timeInterval = $value; - } elsif ($item eq 'versionsPerInterval') { - $versionsPerInterval = $value; - } elsif ($item eq 'versionTimeLimit') { - $versionTimeLimit = $value; - } elsif ($item eq 'problemRandOrder') { - $problemRandOrder = $value; - } elsif ($item eq 'problemsPerPage') { - $problemsPerPage = $value; - } elsif ($item eq 'hideScore') { - $hideScore = ($value) ? $value : 'N'; - } elsif ($item eq 'hideScoreByProblem') { - $hideScoreByProblem = ($value) ? $value : 'N'; - } elsif ($item eq 'hideWork') { - $hideWork = ($value) ? $value : 'N'; - } elsif ($item eq 'capTimeLimit') { - $timeCap = ($value) ? 1 : 0; - } elsif ($item eq 'restrictIP') { - $restrictIP = ($value) ? $value : 'No'; - } elsif ($item eq 'restrictLocation') { - $restrictLoc = ($value) ? $value : ''; - } elsif ($item eq 'relaxRestrictIP') { - $relaxRestrictIP = ($value) ? $value : 'No'; - } elsif ($item eq 'emailInstructor') { - $emailInstructor = ($value) ? $value : 0; - } elsif ($item eq 'restrictProbProgression') { - $restrictProbProgression = ($value) ? $value : 0; - } elsif ($item eq 'description') { - $value =~ s//\n/g; - $description = $value; - } elsif ($item eq 'problemList' - || $item eq 'problemListV2') - { - $listType = $item; - last; - } else { - warn $c->maketext("readSetDef error, can't read the line: ||[_1]||", $line); - } - } - - # Check and format dates - my ($time1, $time2, $time3) = map { $c->parseDateTime($_); } ($openDate, $dueDate, $answerDate); - - unless ($time1 <= $time2 and $time2 <= $time3) { - warn $c->maketext('The open date: [_1], close date: [_2], and answer date: [_3] ' - . 'must be defined and in chronological order.', - $openDate, $dueDate, $answerDate); - } - - # validate reduced credit date - - # Special handling for values which seem to roughly correspond to epoch 0. - # namely if the date string contains 12/31/1969 or 01/01/1970 - if ($reducedScoringDate) { - if (($reducedScoringDate =~ m+12/31/1969+) || ($reducedScoringDate =~ m+01/01/1970+)) { - my $origReducedScoringDate = $reducedScoringDate; - $reducedScoringDate = $c->parseDateTime($reducedScoringDate); - if ($reducedScoringDate != 0) { - # In this case we want to treat it BY FORCE as if the value did correspond to epoch 0. - warn $c->maketext( - 'The reduced credit date [_1] in the file probably was generated from ' - . 'the Unix epoch 0 value and is being treated as if it was Unix epoch 0.', - $origReducedScoringDate - ); - $reducedScoringDate = 0; - } - } else { - # Original behavior, which may cause problems for some time-zones when epoch 0 was set and does not - # parse back to 0. - $reducedScoringDate = $c->parseDateTime($reducedScoringDate); - } - } - - if ($reducedScoringDate) { - if ($reducedScoringDate < $time1 || $reducedScoringDate > $time2) { - warn $c->maketext("The reduced credit date should be between the open date [_1] and close date [_2]", - $openDate, $dueDate); - } elsif ($reducedScoringDate == 0 && $enableReducedScoring ne 'Y') { - # In this case - the date in the file was Unix epoch 0 (or treated as such), - # and unless $enableReducedScoring eq 'Y' we will leave it as 0. - } - } else { - $reducedScoringDate = $time2 - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; - } - - if ($enableReducedScoring ne '' && $enableReducedScoring eq 'Y') { - $enableReducedScoring = 1; - } elsif ($enableReducedScoring ne '' && $enableReducedScoring eq 'N') { - $enableReducedScoring = 0; - } elsif ($enableReducedScoring ne '') { - warn( - $c->maketext("The value [_1] for enableReducedScoring is not valid; it will be replaced with 'N'.", - $enableReducedScoring) - . "\n" - ); - $enableReducedScoring = 0; - } else { - $enableReducedScoring = DEFAULT_ENABLED_REDUCED_SCORING_STATE; - } - - # Check header file names - $paperHeaderFile =~ s/(.*?)\s*$/$1/; # Remove trailing white space - $screenHeaderFile =~ s/(.*?)\s*$/$1/; # Remove trailing white space - - # Gateway/version variable cleanup: convert times into seconds - $assignmentType ||= 'default'; - - $timeInterval = WeBWorK::Utils::timeToSec($timeInterval) - if ($timeInterval); - $versionTimeLimit = WeBWorK::Utils::timeToSec($versionTimeLimit) - if ($versionTimeLimit); - - # Check that the values for hideWork and hideScore are valid. - if ($hideScore ne 'N' - && $hideScore ne 'Y' - && $hideScore ne 'BeforeAnswerDate') - { - warn( - $c->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", - $hideScore) - . "\n" - ); - $hideScore = 'N'; - } - if ($hideScoreByProblem ne 'N' - && $hideScoreByProblem ne 'Y' - && $hideScoreByProblem ne 'BeforeAnswerDate') - { - warn( - $c->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", - $hideScoreByProblem) - . "\n" - ); - $hideScoreByProblem = 'N'; - } - if ($hideWork ne 'N' - && $hideWork ne 'Y' - && $hideWork ne 'BeforeAnswerDate') - { - warn( - $c->maketext("The value [_1] for the hideWork option is not valid; it will be replaced with 'N'.", - $hideWork) - . "\n" - ); - $hideWork = 'N'; - } - if ($timeCap ne '0' && $timeCap ne '1') { - warn( - $c->maketext( - "The value [_1] for the capTimeLimit option is not valid; it will be replaced with '0'.", - $timeCap) - . "\n" - ); - $timeCap = '0'; - } - if ($restrictIP ne 'No' - && $restrictIP ne 'DenyFrom' - && $restrictIP ne 'RestrictTo') - { - warn( - $c->maketext( - "The value [_1] for the restrictIP option is not valid; it will be replaced with 'No'.", - $restrictIP) - . "\n" - ); - $restrictIP = 'No'; - $restrictLoc = ''; - $relaxRestrictIP = 'No'; - } - if ($relaxRestrictIP ne 'No' - && $relaxRestrictIP ne 'AfterAnswerDate' - && $relaxRestrictIP ne 'AfterVersionAnswerDate') - { - warn( - $c->maketext( - "The value [_1] for the relaxRestrictIP option is not valid; it will be replaced with 'No'.", - $relaxRestrictIP) - . "\n" - ); - $relaxRestrictIP = 'No'; - } - # to verify that restrictLoc is valid requires a database - # call, so we defer that until we return to add the set - - # Read and check list of problems for the set - - # NOTE: There are now two versions of problemList, the first is an unlabeled - # list which may or may not contain a showMeAnother variable. This is supported - # but the unlabeled list is hard to work with. The new version prints a - # labeled list of values similar to how its done for the set variables - - if ($listType eq 'problemList') { - - while (my $line = <$SETFILENAME>) { - chomp $line; - $line =~ s/(#.*)//; ## don't read past comments - unless ($line =~ /\S/) { next; } ## skip blank lines - - # commas are valid in filenames, so we have to handle commas - # using backslash escaping, so \X will be replaced with X - my @line = (); - my $curr = ''; - for (my $i = 0; $i < length $line; $i++) { - my $c = substr($line, $i, 1); - if ($c eq '\\') { - $curr .= substr($line, ++$i, 1); - } elsif ($c eq ',') { - push @line, $curr; - $curr = ''; - } else { - $curr .= $c; - } - } - # anything left? - push(@line, $curr) if ($curr); - - # read the line and only look for $showMeAnother if it has the correct number of entries - # otherwise the default value will be used - if (scalar(@line) == 4) { - ($name, $weight, $attemptLimit, $showMeAnother, $continueFlag) = @line; - } else { - ($name, $weight, $attemptLimit, $continueFlag) = @line; - } - - # clean up problem values - $name =~ s/\s*//g; - $weight = "" unless defined($weight); - $weight =~ s/[^\d\.]*//g; - unless ($weight =~ /\d+/) { $weight = $weight_default; } - $attemptLimit = "" unless defined($attemptLimit); - $attemptLimit =~ s/[^\d-]*//g; - unless ($attemptLimit =~ /\d+/) { $attemptLimit = $max_attempts_default; } - $continueFlag = "0" unless (defined($continueFlag) && @problemData); - # can't put continuation flag onto the first problem - push( - @problemData, - { - source_file => $name, - value => $weight, - max_attempts => $attemptLimit, - showMeAnother => $showMeAnother, - continuation => $continueFlag, - # Use defaults for these since they are not going to be in the file. - prPeriod => $prPeriod_default, - showHintsAfter => $showHintsAfter_default, - } - ); - } - } else { - # This is the new version, it looks for pairs of entries - # of the form field name = value - while (my $line = <$SETFILENAME>) { - - chomp $line; - $line =~ s|(#.*)||; # Don't read past comments - unless ($line =~ /\S/) { next; } # Skip blank lines - $line =~ s|\s*$||; # Trim trailing spaces - $line =~ m|^\s*(\w+)\s*=?\s*(.*)|; - - # sanity check entries - my $item = $1; - $item = '' unless defined $item; - my $value = $2; - $value = '' unless defined $value; - - if ($item eq 'problem_start') { - next; - } elsif ($item eq 'source_file') { - warn($c->maketext('No source_file for problem in .def file')) unless $value; - $name = $value; - } elsif ($item eq 'value') { - $weight = ($value) ? $value : $weight_default; - } elsif ($item eq 'max_attempts') { - $attemptLimit = ($value) ? $value : $max_attempts_default; - } elsif ($item eq 'showMeAnother') { - $showMeAnother = ($value) ? $value : 0; - } elsif ($item eq 'showHintsAfter') { - $showHintsAfter = ($value) ? $value : -2; - } elsif ($item eq 'prPeriod') { - $prPeriod = ($value) ? $value : 0; - } elsif ($item eq 'restrictProbProgression') { - $restrictProbProgression = ($value) ? $value : 'No'; - } elsif ($item eq 'problem_id') { - $problemID = ($value) ? $value : ''; - } elsif ($item eq 'counts_parent_grade') { - $countsParentGrade = ($value) ? $value : 0; - } elsif ($item eq 'att_to_open_children') { - $attToOpenChildren = ($value) ? $value : 0; - } elsif ($item eq 'problem_end') { - - # clean up problem values - $name =~ s/\s*//g; - $weight = "" unless defined($weight); - $weight =~ s/[^\d\.]*//g; - unless ($weight =~ /\d+/) { $weight = $weight_default; } - $attemptLimit = "" unless defined($attemptLimit); - $attemptLimit =~ s/[^\d-]*//g; - unless ($attemptLimit =~ /\d+/) { $attemptLimit = $max_attempts_default; } - - unless ($countsParentGrade =~ /(0|1)/) { $countsParentGrade = $counts_parent_grade_default; } - $countsParentGrade =~ s/[^\d-]*//g; - - unless ($showMeAnother =~ /-?\d+/) { $showMeAnother = $showMeAnother_default; } - $showMeAnother =~ s/[^\d-]*//g; - - unless ($showHintsAfter =~ /-?\d+/) { $showHintsAfter = $showHintsAfter_default; } - $showHintsAfter =~ s/[^\d-]*//g; - - unless ($prPeriod =~ /-?\d+/) { $prPeriod = $prPeriod_default; } - $prPeriod =~ s/[^\d-]*//g; - - unless ($attToOpenChildren =~ /\d+/) { $attToOpenChildren = $att_to_open_children_default; } - $attToOpenChildren =~ s/[^\d-]*//g; - - if ($assignmentType eq 'jitar') { - unless ($problemID =~ /[\d\.]+/) { $problemID = ''; } - $problemID =~ s/[^\d\.-]*//g; - $problemID = seq_to_jitar_id(split(/\./, $problemID)); - } else { - unless ($problemID =~ /\d+/) { $problemID = ''; } - $problemID =~ s/[^\d-]*//g; - } - - # can't put continuation flag onto the first problem - push( - @problemData, - { - source_file => $name, - problemID => $problemID, - value => $weight, - max_attempts => $attemptLimit, - showMeAnother => $showMeAnother, - showHintsAfter => $showHintsAfter, - prPeriod => $prPeriod, - attToOpenChildren => $attToOpenChildren, - countsParentGrade => $countsParentGrade, - } - ); - - # reset the various values - $name = ''; - $problemID = ''; - $weight = ''; - $attemptLimit = ''; - $showMeAnother = ''; - $showHintsAfter = ''; - $attToOpenChildren = ''; - $countsParentGrade = ''; - - } else { - warn $c->maketext("readSetDef error, can't read the line: ||[_1]||", $line); - } - } - - } - - $SETFILENAME->close; - return ( - $setName, $paperHeaderFile, $screenHeaderFile, $time1, - $time2, $time3, \@problemData, $assignmentType, - $enableReducedScoring, $reducedScoringDate, $attemptsPerVersion, $timeInterval, - $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, - $hideScore, $hideScoreByProblem, $hideWork, $timeCap, - $restrictIP, $restrictLoc, $relaxRestrictIP, $description, - $emailInstructor, $restrictProbProgression - ); - } else { - warn $c->maketext("Can't open file [_1]", $filePath) . "\n"; - return; - } -} - -sub exportSetsToDef ($c, %filenames) { - my $ce = $c->ce; - my $db = $c->db; - - my (@exported, @skipped, %reason); - -SET: foreach my $set (keys %filenames) { - - my $fileName = $filenames{$set}; - $fileName .= ".def" unless $fileName =~ m/\.def$/; - $fileName = "set" . $fileName unless $fileName =~ m/^set/; - # files can be exported to sub directories but not parent directories - if ($fileName =~ /\.\./) { - push @skipped, $set; - $reason{$set} = $c->maketext("Illegal filename contains '..'"); - next SET; - } - - my $setRecord = $db->getGlobalSet($set); - unless (defined $setRecord) { - push @skipped, $set; - $reason{$set} = $c->maketext("No record found."); - next SET; - } - my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName; - - # back up existing file - if (-e $filePath) { - rename($filePath, "$filePath.bak") - or $reason{$set} = $c->maketext("Existing file [_1] could not be backed up and was lost.", $filePath); - } - - my $openDate = $c->formatDateTime($setRecord->open_date); - my $dueDate = $c->formatDateTime($setRecord->due_date); - my $answerDate = $c->formatDateTime($setRecord->answer_date); - my $reducedScoringDate = $c->formatDateTime($setRecord->reduced_scoring_date); - my $description = $setRecord->description; - if ($description) { - $description =~ s/\r?\n//g; - } - - my $assignmentType = $setRecord->assignment_type; - my $enableReducedScoring = $setRecord->enable_reduced_scoring ? 'Y' : 'N'; - my $setHeader = $setRecord->set_header; - my $paperHeader = $setRecord->hardcopy_header; - my $emailInstructor = $setRecord->email_instructor; - my $restrictProbProgression = $setRecord->restrict_prob_progression; - - my @problemList = $db->getGlobalProblemsWhere({ set_id => $set }, 'problem_id'); - - my $problemList = ''; - for my $problemRecord (@problemList) { - my $problem_id = $problemRecord->problem_id(); - - if ($setRecord->assignment_type eq 'jitar') { - $problem_id = join('.', jitar_id_to_seq($problem_id)); - } - - my $source_file = $problemRecord->source_file(); - my $value = $problemRecord->value(); - my $max_attempts = $problemRecord->max_attempts(); - my $showMeAnother = $problemRecord->showMeAnother(); - my $showHintsAfter = $problemRecord->showHintsAfter(); - my $prPeriod = $problemRecord->prPeriod(); - my $countsParentGrade = $problemRecord->counts_parent_grade(); - my $attToOpenChildren = $problemRecord->att_to_open_children(); - - # backslash-escape commas in fields - $source_file =~ s/([,\\])/\\$1/g; - $value =~ s/([,\\])/\\$1/g; - $max_attempts =~ s/([,\\])/\\$1/g; - $showMeAnother =~ s/([,\\])/\\$1/g; - $showHintsAfter =~ s/([,\\])/\\$1/g; - $prPeriod =~ s/([,\\])/\\$1/g; - - # This is the new way of saving problem information - # the labelled list makes it easier to add variables and - # easier to tell when they are missing - $problemList .= "problem_start\n"; - $problemList .= "problem_id = $problem_id\n"; - $problemList .= "source_file = $source_file\n"; - $problemList .= "value = $value\n"; - $problemList .= "max_attempts = $max_attempts\n"; - $problemList .= "showMeAnother = $showMeAnother\n"; - $problemList .= "showHintsAfter = $showHintsAfter\n"; - $problemList .= "prPeriod = $prPeriod\n"; - $problemList .= "counts_parent_grade = $countsParentGrade\n"; - $problemList .= "att_to_open_children = $attToOpenChildren \n"; - $problemList .= "problem_end\n"; - } - - # gateway fields - my $gwFields = ''; - if ($assignmentType =~ /gateway/) { - my $attemptsPerV = $setRecord->attempts_per_version; - my $timeInterval = $setRecord->time_interval; - my $vPerInterval = $setRecord->versions_per_interval; - my $vTimeLimit = $setRecord->version_time_limit; - my $probRandom = $setRecord->problem_randorder; - my $probPerPage = $setRecord->problems_per_page; - my $hideScore = $setRecord->hide_score; - my $hideScoreByProblem = $setRecord->hide_score_by_problem; - my $hideWork = $setRecord->hide_work; - my $timeCap = $setRecord->time_limit_cap; - $gwFields = <restrict_ip; - my $restrictFields = ''; - if ($restrictIP && $restrictIP ne 'No') { - # only store the first location - my $restrictLoc = ($db->listGlobalSetLocations($setRecord->set_id))[0]; - my $relaxRestrict = $setRecord->relax_restrict_ip; - $restrictLoc || ($restrictLoc = ''); - $restrictFields = - "restrictIP = $restrictIP" - . "\nrestrictLocation = $restrictLoc\n" - . "relaxRestrictIP = $relaxRestrict\n"; - } - - my $fileContents = <{courseDirs}->{templates}, $filePath); - eval { - open(my $SETDEF, '>', $filePath) or die $c->maketext("Failed to open [_1]", $filePath); - print $SETDEF $fileContents; - close $SETDEF; - }; - - if ($@) { - push @skipped, $set; - $reason{$set} = $@; - } else { - push @exported, $set; - } - - } - - return \@exported, \@skipped, \%reason; -} - 1; diff --git a/lib/WeBWorK/File/SetDef.pm b/lib/WeBWorK/File/SetDef.pm new file mode 100644 index 0000000000..b461167ae0 --- /dev/null +++ b/lib/WeBWorK/File/SetDef.pm @@ -0,0 +1,789 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# 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::File::SetDef; +use Mojo::Base 'Exporter', -signatures; + +=head1 NAME + +WeBWorK::File::SetDef - utilities for dealing with set definition files. + +=cut + +use Carp; + +use WeBWorK::Debug; +use WeBWorK::Utils qw(timeToSec x parseDateTime formatDateTime format_set_name_display seq_to_jitar_id jitar_id_to_seq); +use WeBWorK::Utils::Instructor qw(assignSetToUser assignSetToAllUsers addProblemToSet); + +our @EXPORT_OK = qw(importSetsFromDef readSetDef exportSetsToDef); + +=head2 importSetsFromDef + +Usage: C + +Import requested set definition files into the course. + +$ce must be a course environment object and $db a database object for the +course. + +$setDefFiles must be a reference to an array of set definition file names with +path relative to the course templates directory. + +$existingSets must be a reference to an array containing set ids of existing +sets in the course if provided. If it is not provided, then the list of +existing sets will be obtained from the database. + +$assign is either 'all', a user id for a particular user to assign the imported +sets to, or something that evaluates to false. If it evaluates to false the +imported sets will not be assigned to any users. + +$startDate is a date to shift the set dates relative to. + +$newSetName is an optional name for the imported set. This can only be passed +when one set is begin imported. + +This returns a reference to an array of set ids of added sets, a reference to an +array of set ids of skipped sets, and a reference to an array of errors that +occurred in the process. Note that each entry in the array of errors is a +reference to an array whose contents are suitable to be passed directly to +maketext. + +=cut + +sub importSetsFromDef ($ce, $db, $setDefFiles, $existingSets = undef, $assign = '', $startDate = 0, $newSetName = '') { + my $minDate = 0; + + # Restrict to filenames that contain at least one non-whitespace character. + my @setDefFiles = grep {/\S/} @$setDefFiles; + + croak '$newSetName should not be passed when importing multiple set definitions files.' + if $newSetName && @setDefFiles > 1; + + # Get the list of existing sets for the course if that was not provided. + $existingSets = [ $db->listGlobalSets ] unless (ref($existingSets) eq 'ARRAY'); + + # Get a list of set ids of existing sets in the course. This is used to + # ensure that an imported set does not already exist. + my %allSets = map { $_ => 1 } @$existingSets; + + my (@added, @skipped, @errors); + + for my $set_definition_file (@setDefFiles) { + debug("$set_definition_file: reading set definition file"); + + # Read the data from the set definition file. + my ($setData, $readErrors) = readSetDef($ce, $set_definition_file); + push(@errors, @$readErrors) if @$readErrors; + + # Use the original name if a new name was not specified. + $setData->{setID} = $newSetName if $newSetName; + + my $prettySetID = format_set_name_display($setData->{setID}); + + if ($allSets{ $setData->{setID} }) { + # This set already exists! + push @skipped, $setData->{setID}; + push @errors, [ x('The set [_1] already exists.', $prettySetID) ]; + next; + } + + # Keep track of which as the earliest open date. + if ($minDate > $setData->{openDate} || $minDate == 0) { + $minDate = $setData->{openDate}; + } + + debug("$set_definition_file: adding set"); + # Add the data to the set record + my $newSetRecord = $db->newGlobalSet; + $newSetRecord->set_id($setData->{setID}); + $newSetRecord->set_header($setData->{screenHeaderFile}); + $newSetRecord->hardcopy_header($setData->{paperHeaderFile}); + $newSetRecord->open_date($setData->{openDate}); + $newSetRecord->due_date($setData->{dueDate}); + $newSetRecord->answer_date($setData->{answerDate}); + $newSetRecord->visible(1); + $newSetRecord->reduced_scoring_date($setData->{reducedScoringDate}); + $newSetRecord->enable_reduced_scoring($setData->{enableReducedScoring}); + $newSetRecord->description($setData->{description}); + $newSetRecord->email_instructor($setData->{emailInstructor}); + $newSetRecord->restrict_prob_progression($setData->{restrictProbProgression}); + + # Gateway/version data. These are all initialized to '' by readSetDef. + # So for non-gateway/versioned sets they'll just be stored as NULL. + $newSetRecord->assignment_type($setData->{assignmentType}); + $newSetRecord->attempts_per_version($setData->{attemptsPerVersion}); + $newSetRecord->time_interval($setData->{timeInterval}); + $newSetRecord->versions_per_interval($setData->{versionsPerInterval}); + $newSetRecord->version_time_limit($setData->{versionTimeLimit}); + $newSetRecord->problem_randorder($setData->{problemRandOrder}); + $newSetRecord->problems_per_page($setData->{problemsPerPage}); + $newSetRecord->hide_score($setData->{hideScore}); + $newSetRecord->hide_score_by_problem($setData->{hideScoreByProblem}); + $newSetRecord->hide_work($setData->{hideWork}); + $newSetRecord->time_limit_cap($setData->{capTimeLimit}); + $newSetRecord->restrict_ip($setData->{restrictIP}); + $newSetRecord->relax_restrict_ip($setData->{relaxRestrictIP}); + + # Create the set + eval { $db->addGlobalSet($newSetRecord) }; + if ($@) { + push @skipped, $setData->{setID}; + push @errors, [ x('Error creating set [_1]: [_2]'), $prettySetID, $@ ]; + next; + } + + push @added, $setData->{setID}; + + # Add locations to the set_locations table + if ($setData->{restrictIP} ne 'No' && $setData->{restrictLocation}) { + if ($db->existsLocation($setData->{restrictLocation})) { + if (!$db->existsGlobalSetLocation($setData->{setID}, $setData->{restrictLocation})) { + my $newSetLocation = $db->newGlobalSetLocation; + $newSetLocation->set_id($setData->{setID}); + $newSetLocation->location_id($setData->{restrictLocation}); + eval { $db->addGlobalSetLocation($newSetLocation) }; + if ($@) { + push + @errors, + [ + x('Error adding IP restriction location "[_1]" for set [_2]: [_3]'), + $setData->{restrictLocation}, + $prettySetID, $@ + ]; + } + } else { + # This should never happen. + push + @errors, + [ + x('IP restriction location "[_1]" for set [_2] already exists.'), + $setData->{restrictLocation}, $prettySetID + ]; + } + } else { + push + @errors, + [ + x( + 'IP restriction location "[_1]" for set [_2] does not exist. ' + . 'IP restrictions have been ignored.' + ), + $setData->{restrictLocation}, + $prettySetID + ]; + $newSetRecord->restrict_ip('No'); + $newSetRecord->relax_restrict_ip('No'); + eval { $db->putGlobalSet($newSetRecord) }; + # Ignore error messages here. If the set was added without error before, + # we assume (ha) that it will be added again without trouble. + } + } + + debug("$set_definition_file: adding problems to database"); + # Add problems + my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setData->{setID})) + 1; + for my $rh_problem (@{ $setData->{problemData} }) { + addProblemToSet( + $db, $ce->{problemDefaults}, + setName => $setData->{setID}, + sourceFile => $rh_problem->{source_file}, + problemID => $rh_problem->{problemID} ? $rh_problem->{problemID} : $freeProblemID++, + value => $rh_problem->{value}, + maxAttempts => $rh_problem->{max_attempts}, + showMeAnother => $rh_problem->{showMeAnother}, + showHintsAfter => $rh_problem->{showHintsAfter}, + prPeriod => $rh_problem->{prPeriod}, + attToOpenChildren => $rh_problem->{attToOpenChildren}, + countsParentGrade => $rh_problem->{countsParentGrade} + ); + } + + if ($assign eq 'all') { + assignSetToAllUsers($db, $ce, $setData->{setID}); + } elsif ($assign) { + assignSetToUser($db, $assign, $newSetRecord); + } + } + + # If there is a start date we have to reopen all of the sets that were added and shift the dates. + if ($startDate) { + # The shift for all of the dates is from the min date to the start date + my $dateShift = $startDate - $minDate; + + for my $setID (@added) { + my $setRecord = $db->getGlobalSet($setID); + $setRecord->open_date($setRecord->open_date + $dateShift); + $setRecord->reduced_scoring_date($setRecord->reduced_scoring_date + $dateShift); + $setRecord->due_date($setRecord->due_date + $dateShift); + $setRecord->answer_date($setRecord->answer_date + $dateShift); + $db->putGlobalSet($setRecord); + } + } + + return \@added, \@skipped, \@errors; +} + +=head2 readSetDef + +Usage: C + +Read and parse a set definition file. + +$ce must be a course environment object for the course. + +$filename should be the set definition file with path relative to the course +templates directory. + +Returns a reference to a hash containing the information from the set definition +file and a reference to an array of errors in the file. See C<%data> and +C<%data{problemData}> for details on the contents of the return set definition +file data. Also note that each entry in the array of errors is a reference to +an array whose contents are suitable to be passed directly to maketext. + +=cut + +sub readSetDef ($ce, $fileName) { + my $filePath = "$ce->{courseDirs}{templates}/$fileName"; + + my %data = ( + setID => 'Invalid Set Definition Filename', + problemData => [], + paperHeaderFile => '', + screenHeaderFile => '', + openDate => '', + dueDate => '', + answerDate => '', + reducedScoringDate => '', + assignmentType => 'default', + enableReducedScoring => '', + attemptsPerVersion => '', + timeInterval => '', + versionsPerInterval => '', + versionTimeLimit => '', + problemRandOrder => '', + problemsPerPage => '', + hideScore => 'N', + hideScoreByProblem => 'N', + hideWork => 'N', + capTimeLimit => 0, + restrictIP => 'No', + restrictLocation => '', + relaxRestrictIP => 'No', + description => '', + emailInstructor => '', + restrictProbProgression => '' + ); + + my @errors; + + $data{setID} = $2 if ($fileName =~ m|^(.*/)?set([.\w-]+)\.def$|); + + if (my $setFH = Mojo::File->new($filePath)->open('<')) { + my $listType = ''; + + # Read and check set data + while (my $line = <$setFH>) { + chomp $line; + $line =~ s|(#.*)||; # Don't read past comments + unless ($line =~ /\S/) { next; } # Skip blank lines + $line =~ s/^\s*|\s*$//; # Trim spaces + $line =~ m|^(\w+)\s*=?\s*(.*)|; + + my $item = $1 // ''; + my $value = $2; + + if ($item eq 'setNumber') { + next; + } elsif (defined $data{$item}) { + $data{$item} = $value if defined $value; + } elsif ($item eq 'problemList' || $item eq 'problemListV2') { + $listType = $item; + last; + } else { + push(@errors, [ x('Invalid line in file "[_1]": ||[_2]||'), $fileName, $line ]); + } + } + + # Change 's to new lines in the set description. + $data{description} =~ s//\n/g; + + # Check and format dates + ($data{openDate}, $data{dueDate}, $data{answerDate}) = + map { parseDateTime($_, $ce->{siteDefaults}{timezone}) } + ($data{openDate}, $data{dueDate}, $data{answerDate}); + + unless (defined $data{openDate} + && defined $data{dueDate} + && defined $data{answerDate} + && $data{openDate} <= $data{dueDate} + && $data{dueDate} <= $data{answerDate}) + { + $data{dueDate} = time + 2 * 60 * 60 * 24 * 7 unless defined $data{dueDate}; + $data{openDate} = $data{dueDate} - 60 * $ce->{pg}{assignOpenPriorToDue} + if !defined $data{openDate} || $data{openDate} > $data{dueDate}; + $data{answerDate} = $data{dueDate} + 60 * $ce->{pg}{answersOpenAfterDueDate} + if !defined $data{answerDate} || $data{dueDate} > $data{answerDate}; + + push( + @errors, + [ + x( + 'The open date, due date, and answer date in "[_1]" are not in chronological order.' + . 'Default values will be used for dates that are out of order.' + ), + $fileName + ] + ); + } + + if ($data{enableReducedScoring} eq 'Y') { + $data{enableReducedScoring} = 1; + } elsif ($data{enableReducedScoring} eq 'N') { + $data{enableReducedScoring} = 0; + } elsif ($data{enableReducedScoring} ne '') { + push( + @errors, + [ + x('The value for enableReducedScoring in "[_1]" is not valid. It will be replaced with "N".'), + $fileName + ] + ); + $data{enableReducedScoring} = 0; + } else { + $data{enableReducedScoring} = 0; + } + + # Validate reduced scoring date + if ($data{reducedScoringDate}) { + if ($data{reducedScoringDate} =~ m+12/31/1969+ || $data{reducedScoringDate} =~ m+01/01/1970+) { + # Set the reduced scoring date to 0 for values which seem to roughly correspond to epoch 0. + $data{reducedScoringDate} = 0; + } else { + $data{reducedScoringDate} = parseDateTime($data{reducedScoringDate}, $ce->{siteDefaults}{timezone}); + } + } + + if ($data{reducedScoringDate}) { + if ($data{reducedScoringDate} < $data{openDate} || $data{reducedScoringDate} > $data{dueDate}) { + $data{reducedScoringDate} = $data{dueDate} - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + + # If reduced scoring is enabled for the set, then add an error regarding this issue. + # Otherwise let it go. + if ($data{enableReducedScoring}) { + push( + @errors, + [ + x( + 'The reduced credit date in "[_1]" is not between the open date and close date. ' + . 'The default value will be used.' + ), + $fileName + ] + ); + } + } + } else { + $data{reducedScoringDate} = $data{dueDate} - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + } + + # Convert Gateway times into seconds. + $data{timeInterval} = timeToSec($data{timeInterval}) if ($data{timeInterval}); + $data{versionTimeLimit} = timeToSec($data{versionTimeLimit}) if ($data{versionTimeLimit}); + + # Check that the values for hideScore and hideWork are valid. + for (qw(hideScore hideWork)) { + if ($data{$_} ne 'N' && $data{$_} ne 'Y' && $data{$_} ne 'BeforeAnswerDate') { + push( + @errors, + [ + x('The value for the [_1] option in "[_2]" is not valid. It will be replaced with "N".'), + $_, $fileName + ] + ); + $data{$_} = 'N'; + } + } + + if ($data{hideScoreByProblem} ne 'N' && $data{hideScoreByProblem} ne 'Y') { + push( + @errors, + [ + x( + 'The value for the hideScoreByProblem option in "[_1]" is not valid. ' + . 'It will be replaced with "N".', + $fileName + ) + ] + ); + $data{hideScoreByProblem} = 'N'; + } + + if ($data{capTimeLimit} ne '0' && $data{capTimeLimit} ne '1') { + push( + @errors, + [ + x( + 'The value for the capTimeLimit option in "[_1]" is not valid. It will be replaced with "0".'), + $fileName + ] + ); + $data{capTimeLimit} = '0'; + } + + if ($data{restrictIP} ne 'No' && $data{restrictIP} ne 'DenyFrom' && $data{restrictIP} ne 'RestrictTo') { + push( + @errors, + [ + x('The value for the restrictIP option in "[_1]" is not valid. It will be replaced with "No".'), + $fileName + ] + ); + $data{restrictIP} = 'No'; + $data{restrictLocation} = ''; + $data{relaxRestrictIP} = 'No'; + } + + if ($data{relaxRestrictIP} ne 'No' + && $data{relaxRestrictIP} ne 'AfterAnswerDate' + && $data{relaxRestrictIP} ne 'AfterVersionAnswerDate') + { + push( + @errors, + [ + x( + 'The value for the relaxRestrictIP option in "[_1]" is not valid. ' + . 'It will be replaced with "No".' + ), + $fileName + ] + ); + $data{relaxRestrictIP} = 'No'; + } + + # Validation of restrictLocation requires a database call. That is deferred until the set is added. + + # Read and check list of problems for the set + + # NOTE: There are two versions of problemList, the first is an unlabeled list which may or may not contain some + # newer variables. This is supported but the unlabeled list is hard to work with. The new version prints a + # labeled list of values similar to how its done for the set variables. + + if ($listType eq 'problemList') { + # The original set definition file type. + while (my $line = <$setFH>) { + chomp $line; + $line =~ s/(#.*)//; # Don't read past comments + unless ($line =~ /\S/) { next; } # Skip blank lines + + # Commas are valid in filenames, so we have to handle commas + # using backslash escaping. So \X will be replaced with X. + my @line = (); + my $curr = ''; + for (my $i = 0; $i < length $line; ++$i) { + my $c = substr($line, $i, 1); + if ($c eq '\\') { + $curr .= substr($line, ++$i, 1); + } elsif ($c eq ',') { + push @line, $curr; + $curr = ''; + } else { + $curr .= $c; + } + } + # Anything left? + push(@line, $curr) if ($curr); + + # Exract the problem data from the line. + my ($name, $weight, $attemptLimit, $showMeAnother) = @line; + + # Clean up problem values + $name =~ s/\s*//g; + + $weight //= ''; + $weight =~ s/[^\d\.]*//g; + unless ($weight =~ /\d+/) { $weight = $ce->{problemDefaults}{value}; } + + $attemptLimit //= ''; + $attemptLimit =~ s/[^\d-]*//g; + unless ($attemptLimit =~ /\d+/) { $attemptLimit = $ce->{problemDefaults}{max_attempts}; } + + push( + @{ $data{problemData} }, + { + source_file => $name, + value => $weight, + max_attempts => $attemptLimit, + showMeAnother => $showMeAnother // $ce->{problemDefaults}{showMeAnother}, + # Use defaults for these since they are not going to be in the file. + prPeriod => $ce->{problemDefaults}{prPeriod}, + showHintsAfter => $ce->{problemDefaults}{showHintsAfter}, + } + ); + } + } else { + # Set definition version 2. + my $problemData = {}; + while (my $line = <$setFH>) { + chomp $line; + $line =~ s|#.*||; # Don't read past comments + unless ($line =~ /\S/) { next; } # Skip blank lines + $line =~ s/^\s*|\s*$//g; # Trim spaces + $line =~ m|^(\w+)\s*=?\s*(.*)|; + + my $item = $1 // ''; + my $value = $2; + + if ($item eq 'problem_start') { + # Initialize the problem data with the defaults. + $problemData = { source_file => '', problem_id => '', %{ $ce->{problemDefaults} } }; + } elsif (defined $problemData->{$item}) { + $problemData->{$item} = $value if defined $value; + } elsif ($item eq 'problem_end') { + # Clean up and validate values + $problemData->{source_file} =~ s/\s*//g; + push(@errors, [ 'No source_file for problem in "[_1]"', $fileName ]) + unless $problemData->{source_file}; + + $problemData->{value} =~ s/[^\d\.]*//g; + $problemData->{value} = $ce->{problemDefaults}{value} + unless $problemData->{value} =~ /\d+/; + + $problemData->{max_attempts} =~ s/[^\d-]*//g; + $problemData->{max_attempts} = $ce->{problemDefaults}{max_attempts} + unless $problemData->{max_attempts} =~ /\d+/; + + $problemData->{counts_parent_grade} = $ce->{problemDefaults}{counts_parent_grade} + unless $problemData->{counts_parent_grade} =~ /(0|1)/; + $problemData->{counts_parent_grade} =~ s/[^\d]*//g; + + $problemData->{showMeAnother} = $ce->{problemDefaults}{showMeAnother} + unless $problemData->{showMeAnother} =~ /-?\d+/; + $problemData->{showMeAnother} =~ s/[^\d-]*//g; + + $problemData->{showHintsAfter} = $ce->{problemDefaults}{showHintsAfter} + unless $problemData->{showHintsAfter} =~ /-?\d+/; + $problemData->{showHintsAfter} =~ s/[^\d-]*//g; + + $problemData->{prPeriod} = $ce->{problemDefaults}{prPeriod} + unless $problemData->{prPeriod} =~ /-?\d+/; + $problemData->{prPeriod} =~ s/[^\d-]*//g; + + $problemData->{att_to_open_children} = $ce->{problemDefaults}{att_to_open_children} + unless ($problemData->{att_to_open_children} =~ /\d+/); + $problemData->{att_to_open_children} =~ s/[^\d-]*//g; + + if ($data{assignmentType} eq 'jitar') { + unless ($problemData->{problem_id} =~ /[\d\.]+/) { $problemData->{problem_id} = ''; } + $problemData->{problem_id} =~ s/[^\d\.-]*//g; + $problemData->{problem_id} = seq_to_jitar_id(split(/\./, $problemData->{problem_id})); + } else { + unless ($problemData->{problem_id} =~ /\d+/) { $problemData->{problem_id} = ''; } + $problemData->{problem_id} =~ s/[^\d-]*//g; + } + + push(@{ $data{problemData} }, $problemData); + } else { + push(@errors, [ x('Invalid line in file "[_1]": ||[_2]||'), $fileName, $line ]); + } + } + } + + $setFH->close; + } else { + push @errors, [ x(q{Can't open file [_1]}, $filePath) ]; + } + + return (\%data, \@errors); +} + +=head2 exportSetsToDef + +Usage: C + +Export sets to set definition files. + +$ce must be a course environment object and $db a database object for the +course. + +@filenames is a list of set ids for the sets to be exported. + +=cut + +sub exportSetsToDef ($ce, $db, @sets) { + my (@exported, @skipped, %reason); + +SET: for my $set (@sets) { + my $fileName = "set$set.def"; + + # Files can be exported to sub directories but not parent directories. + if ($fileName =~ /\.\./) { + push @skipped, $set; + $reason{$set} = [ x(q{Illegal filename contains '..'}) ]; + next SET; + } + + my $setRecord = $db->getGlobalSet($set); + unless (defined $setRecord) { + push @skipped, $set; + $reason{$set} = [ x('No record found.') ]; + next SET; + } + my $filePath = "$ce->{courseDirs}{templates}/$fileName"; + + # Back up existing file + if (-e $filePath) { + rename($filePath, "$filePath.bak") + or do { + push @skipped, $set; + $reason{$set} = [ x('Existing file [_1] could not be backed up.'), $filePath ]; + next SET; + }; + } + + my $openDate = + formatDateTime($setRecord->open_date, $ce->{siteDefaults}{timezone}, undef, $ce->{siteDefaults}{locale}); + my $dueDate = + formatDateTime($setRecord->due_date, $ce->{siteDefaults}{timezone}, undef, $ce->{siteDefaults}{locale}); + my $answerDate = + formatDateTime($setRecord->answer_date, $ce->{siteDefaults}{timezone}, undef, $ce->{siteDefaults}{locale}); + my $reducedScoringDate = formatDateTime( + $setRecord->reduced_scoring_date, + $ce->{siteDefaults}{timezone}, + undef, $ce->{siteDefaults}{locale} + ); + + my $description = ($setRecord->description // '') =~ s/\r?\n//gr; + + my $assignmentType = $setRecord->assignment_type; + my $enableReducedScoring = $setRecord->enable_reduced_scoring ? 'Y' : 'N'; + my $setHeader = $setRecord->set_header; + my $paperHeader = $setRecord->hardcopy_header; + my $emailInstructor = $setRecord->email_instructor; + my $restrictProbProgression = $setRecord->restrict_prob_progression; + + my @problemList = $db->getGlobalProblemsWhere({ set_id => $set }, 'problem_id'); + + my $problemList = ''; + for my $problemRecord (@problemList) { + my $problem_id = $problemRecord->problem_id(); + + $problem_id = join('.', jitar_id_to_seq($problem_id)) if ($setRecord->assignment_type eq 'jitar'); + + my $source_file = $problemRecord->source_file(); + my $value = $problemRecord->value(); + my $max_attempts = $problemRecord->max_attempts(); + my $showMeAnother = $problemRecord->showMeAnother(); + my $showHintsAfter = $problemRecord->showHintsAfter(); + my $prPeriod = $problemRecord->prPeriod(); + my $countsParentGrade = $problemRecord->counts_parent_grade(); + my $attToOpenChildren = $problemRecord->att_to_open_children(); + + # backslash-escape commas in fields + $source_file =~ s/([,\\])/\\$1/g; + $value =~ s/([,\\])/\\$1/g; + $max_attempts =~ s/([,\\])/\\$1/g; + $showMeAnother =~ s/([,\\])/\\$1/g; + $showHintsAfter =~ s/([,\\])/\\$1/g; + $prPeriod =~ s/([,\\])/\\$1/g; + + # This is the new way of saving problem information. + # The labelled list makes it easier to add variables and + # easier to tell when they are missing. + $problemList .= "problem_start\n"; + $problemList .= "problem_id = $problem_id\n"; + $problemList .= "source_file = $source_file\n"; + $problemList .= "value = $value\n"; + $problemList .= "max_attempts = $max_attempts\n"; + $problemList .= "showMeAnother = $showMeAnother\n"; + $problemList .= "showHintsAfter = $showHintsAfter\n"; + $problemList .= "prPeriod = $prPeriod\n"; + $problemList .= "counts_parent_grade = $countsParentGrade\n"; + $problemList .= "att_to_open_children = $attToOpenChildren \n"; + $problemList .= "problem_end\n"; + } + + # Gateway fields + my $gwFields = ''; + if ($assignmentType =~ /gateway/) { + my $attemptsPerV = $setRecord->attempts_per_version; + my $timeInterval = $setRecord->time_interval; + my $vPerInterval = $setRecord->versions_per_interval; + my $vTimeLimit = $setRecord->version_time_limit; + my $probRandom = $setRecord->problem_randorder; + my $probPerPage = $setRecord->problems_per_page; + my $hideScore = $setRecord->hide_score; + my $hideScoreByProblem = $setRecord->hide_score_by_problem; + my $hideWork = $setRecord->hide_work; + my $timeCap = $setRecord->time_limit_cap; + $gwFields = + "attemptsPerVersion = $attemptsPerV\n" + . "timeInterval = $timeInterval\n" + . "versionsPerInterval = $vPerInterval\n" + . "versionTimeLimit = $vTimeLimit\n" + . "problemRandOrder = $probRandom\n" + . "problemsPerPage = $probPerPage\n" + . "hideScore = $hideScore\n" + . "hideScoreByProblem = $hideScoreByProblem\n" + . "hideWork = $hideWork\n" + . "capTimeLimit = $timeCap\n"; + } + + # IP restriction fields + my $restrictIP = $setRecord->restrict_ip; + my $restrictFields = ''; + if ($restrictIP && $restrictIP ne 'No') { + # Only store the first location + my $restrictLoc = ($db->listGlobalSetLocations($setRecord->set_id))[0]; + my $relaxRestrict = $setRecord->relax_restrict_ip; + $restrictLoc || ($restrictLoc = ''); + $restrictFields = + "restrictIP = $restrictIP\n" + . "restrictLocation = $restrictLoc\n" + . "relaxRestrictIP = $relaxRestrict\n"; + } + + my $fileContents = + "assignmentType = $assignmentType\n" + . "openDate = $openDate\n" + . "reducedScoringDate = $reducedScoringDate\n" + . "dueDate = $dueDate\n" + . "answerDate = $answerDate\n" + . "enableReducedScoring = $enableReducedScoring\n" + . "paperHeaderFile = $paperHeader\n" + . "screenHeaderFile = $setHeader\n" + . $gwFields + . "description = $description\n" + . "restrictProbProgression = $restrictProbProgression\n" + . "emailInstructor = $emailInstructor\n" + . $restrictFields + . "\nproblemListV2\n" + . $problemList; + + $filePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $filePath); + if (open(my $setDefFH, '>', $filePath)) { + print $setDefFH $fileContents; + close $setDefFH; + push @exported, $set; + } else { + push @skipped, $set; + $reason{$set} = [ x('Failed to open [_1]'), $filePath ]; + } + } + + return \@exported, \@skipped, \%reason; +} + +1; diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep index c0a6ec31fb..a0d4408362 100644 --- a/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep +++ b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep @@ -64,7 +64,7 @@
<%= select_field 'action.import.assign' => [ [ maketext('all current users') => 'all' ], - [ maketext('only') . ' ' . param('user') => 'user', selected => undef ] + [ maketext('only') . ' ' . param('user') => param('user'), selected => undef ] ], id => 'import_users_select', class => 'form-select form-select-sm' =%>