From 9e45176142467b7b9b4e6e3f22053137b038e4f5 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sat, 19 Aug 2023 06:10:54 -0500 Subject: [PATCH 01/49] Fix the database locking code in `WeBWorK::Utils::CourseIntegrityCheck`. A process should not attempt to unlock the database if it has not first locked the database. What is currently happening is that the database integrity checker locks the database, then unlocks the database, and then when the integrity checker object is destroyed in clean up it attempts to unlock the database again (in the DESTROY method). If there is no lock by any process when that last unlock attempt is fine. However, if another request is sent to the server that also attempts to lock the database while the first request is still processing, then as soon as this request unlocks the database, then the second request locks the database. Then when the first request attempts to unlock the database in clean up, it finds the lock now held by the second process and dies because it can't release the lock now held by the second process. This now sets a flag when the database integrity checker locks the database successfully, clears that flag when the lock is successfully unlocked, and the database is only attempted to be unlocked in clean up if that flag is still set. Furthermore, this never dies when attempting to release a lock if the release attempt fails. There is no reason for that. It just warns in the two cases that a release attempt can fail, and with the new flag the case of a lock owned by another process should not occur (unless someone erroneously calls the `unlock_database` method without first calling the `lock_database` method). This fixes issue #2167. More work needs to be done here. The course integrity checker is really not well thought out. The course database checker and the course directory checker need to be separated into different modules. Directory checking and upgrading does not need a database handle. If one wanted to check or upgrade directory structure without checking or upgrading the database, then this would acquire an unnecessary database handle. In fact directory checking and upgrading don't need an object at all. Those should be exported methods in another non-object package. In addition, there should be checks for exceptions that may be thrown when the database is checked or upgraded. There are lots of ways that can happen in addition to a failed lock attempt (which also really shouldn't die). --- lib/WeBWorK/Utils/CourseIntegrityCheck.pm | 34 +++++++++++------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/lib/WeBWorK/Utils/CourseIntegrityCheck.pm b/lib/WeBWorK/Utils/CourseIntegrityCheck.pm index 70a9b6b2eb..3ece1dc5fb 100644 --- a/lib/WeBWorK/Utils/CourseIntegrityCheck.pm +++ b/lib/WeBWorK/Utils/CourseIntegrityCheck.pm @@ -79,8 +79,7 @@ sub confirm { my ($self, @args) = @_; my $sub = $self->{confirm_sub}; return &$s sub DESTROY { my ($self) = @_; - $self->unlock_database; - $self->SUPER::DESTROY if $self->can("SUPER::DESTROY"); + $self->unlock_database if $self->{db_locked}; return; } @@ -412,29 +411,28 @@ sub updateCourseDirectories { # Database utilities -- borrowed from DBUpgrade.pm ??use or modify??? --MEG ############################################################################## -sub lock_database { # lock named 'webwork.dbugrade' times out after 10 seconds - my $self = shift; - my $dbh = $self->dbh; - my ($lock_status) = $dbh->selectrow_array("SELECT GET_LOCK('webwork.dbupgrade', 10)"); - if (not defined $lock_status) { - die "Couldn't obtain lock because an error occurred.\n"; - } - if (!$lock_status) { +# Create a lock named 'webwork.dbugrade' that times out after 10 seconds. +sub lock_database { + my $self = shift; + my ($lock_status) = $self->dbh->selectrow_array("SELECT GET_LOCK('webwork.dbupgrade', 10)"); + if (!defined $lock_status) { + die "Couldn't obtain lock because a database error occurred.\n"; + } elsif (!$lock_status) { die "Timed out while waiting for lock.\n"; } + $self->{db_locked} = 1; return; } sub unlock_database { - my $self = shift; - my $dbh = $self->dbh; - my ($lock_status) = $dbh->selectrow_array("SELECT RELEASE_LOCK('webwork.dbupgrade')"); - if (not defined $lock_status) { - # die "Couldn't release lock because the lock does not exist.\n"; - } elsif ($lock_status) { - return; + my $self = shift; + my ($lock_status) = $self->dbh->selectrow_array("SELECT RELEASE_LOCK('webwork.dbupgrade')"); + if ($lock_status) { + delete $self->{db_locked}; + } elsif (defined $lock_status) { + warn "Couldn't release lock because the lock is not held by this thread.\n"; } else { - die "Couldn't release lock because the lock is not held by this thread.\n"; + warn "Unable to release lock because a database error occurred.\n"; } return; } From 27c0d4cb7c8bc5ce3878dbf8b1ef4ffdcbd17662 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 2 Jan 2023 19:03:30 -0600 Subject: [PATCH 02/49] 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' =%>
From 4f72e38aea12a922f73709569c707c3a51760d69 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Tue, 8 Aug 2023 16:47:18 -0400 Subject: [PATCH 03/49] Add zip capability to archiving/unarchiving in File Manager --- conf/site.conf.dist | 4 +++- htdocs/js/FileManager/filemanager.js | 2 +- .../Instructor/FileManager.pm | 20 ++++++++++++------- 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/conf/site.conf.dist b/conf/site.conf.dist index 4a00f93e23..f5aae482c5 100644 --- a/conf/site.conf.dist +++ b/conf/site.conf.dist @@ -88,7 +88,9 @@ $externalPrograms{rm} = "/bin/rm"; $externalPrograms{mkdir} = "/bin/mkdir"; $externalPrograms{tar} = "/bin/tar"; $externalPrograms{gzip} = "/bin/gzip"; -$externalPrograms{git} = "/usr/bin/git"; +$externalPrograms{git} = "/usr/bin/git"; +$externalPrograms{unzip} = '/usr/bin/zip'; +$externalPrograms{unzip} = '/usr/bin/unzip'; #################################################### # equation rendering/hardcopy utiltiies diff --git a/htdocs/js/FileManager/filemanager.js b/htdocs/js/FileManager/filemanager.js index 8f579d6bf8..5a55c529e4 100644 --- a/htdocs/js/FileManager/filemanager.js +++ b/htdocs/js/FileManager/filemanager.js @@ -35,7 +35,7 @@ if ( numSelected === 0 || numSelected > 1 || - !/\.(tar|tar\.gz|tgz)$/.test(files.children[files.selectedIndex].value) + !/\.(tar|tar\.gz|tgz|zip)$/.test(files.children[files.selectedIndex].value) ) archiveButton.value = archiveButton.dataset.archiveText; else archiveButton.value = archiveButton.dataset.unarchiveText; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 5869750e92..8b20aa124f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -370,8 +370,8 @@ sub MakeArchive ($c) { sub UnpackArchive ($c) { my $archive = $c->getFile('unpack'); return '' unless $archive; - if ($archive !~ m/\.(tar|tar\.gz|tgz)$/) { - $c->addbadmessage($c->maketext('You can only unpack files ending in ".tgz", ".tar" or ".tar.gz"')); + if ($archive !~ m/\.(tar|tar\.gz|tgz|zip)$/) { + $c->addbadmessage($c->maketext('You can only unpack files ending in ".zip", ".tgz", ".tar" or ".tar.gz"')); } else { $c->unpack_archive($archive); } @@ -379,10 +379,16 @@ sub UnpackArchive ($c) { } sub unpack_archive ($c, $archive) { - my $z = $archive =~ m/\.tar$/ ? '' : 'z'; - my $dir = "$c->{courseRoot}/$c->{pwd}"; - my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); - my @files = readpipe "$tar 2>&1"; + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my @files; + if ($archive =~ m/\.zip$/) { + my $unzip = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{unzip} -u " . shell_quote($archive); + @files = readpipe "$unzip"; + } else { + my $z = $archive =~ m/\.tar$/ ? '' : 'z'; + my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); + @files = readpipe "$tar 2>&1"; + } if ($? == 0) { my $n = scalar(@files); @@ -520,7 +526,7 @@ sub Upload ($c) { if (-e $file) { $c->addgoodmessage($c->maketext('File "[_1]" uploaded successfully', $name)); - if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $c->getFlag('unpack')) { + if ($name =~ m/\.(tar|tar\.gz|tgz|zip)$/ && $c->getFlag('unpack')) { if ($c->unpack_archive($name) && $c->getFlag('autodelete')) { if (unlink($file)) { $c->addgoodmessage($c->maketext('Archive "[_1]" deleted', $name)) } else { $c->addbadmessage($c->maketext(q{Can't delete archive "[_1]": [_2]}, $name, $!)) } From b42783c59d7bc8fd0d0a5175012f7273ab282282 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Thu, 10 Aug 2023 08:48:44 -0400 Subject: [PATCH 04/49] replace call to zip with perl packages and include make archive --- conf/site.conf.dist | 2 - .../Instructor/FileManager.pm | 55 +++++++++++-------- .../Instructor/FileManager/refresh.html.ep | 10 +++- 3 files changed, 41 insertions(+), 26 deletions(-) diff --git a/conf/site.conf.dist b/conf/site.conf.dist index f5aae482c5..9591b1e151 100644 --- a/conf/site.conf.dist +++ b/conf/site.conf.dist @@ -89,8 +89,6 @@ $externalPrograms{mkdir} = "/bin/mkdir"; $externalPrograms{tar} = "/bin/tar"; $externalPrograms{gzip} = "/bin/gzip"; $externalPrograms{git} = "/usr/bin/git"; -$externalPrograms{unzip} = '/usr/bin/zip'; -$externalPrograms{unzip} = '/usr/bin/unzip'; #################################################### # equation rendering/hardcopy utiltiies diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 8b20aa124f..c496122f2c 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -26,6 +26,9 @@ use File::Path; use File::Copy; use File::Spec; use String::ShellQuote; +use Archive::Extract; +use IO::Compress::Zip qw(zip $ZipError); +use Archive::Tar; use WeBWorK::Utils qw(readDirectory readFile sortByName listFilesRecursive); use WeBWorK::Upload; @@ -344,24 +347,37 @@ sub Delete ($c) { } } -# Make a gzipped tar archive +# Make a gzipped tar or zip archive sub MakeArchive ($c) { my @files = $c->param('files'); if (scalar(@files) == 0) { $c->addbadmessage($c->maketext('You must select at least one file for the archive')); return $c->Refresh; } + my $dir = "$c->{courseRoot}/$c->{pwd}"; + chdir $dir; + my @files_to_compress; + + for my $f (@files) { + push(@files_to_compress, glob("$f/**")) if -d $f; + push(@files_to_compress, $f) if -f $f; + } - my $dir = "$c->{courseRoot}/$c->{pwd}"; - my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . '.tgz' : "$c->{courseName}.tgz"); - my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); - @files = readpipe $tar . ' 2>&1'; - if ($? == 0) { - my $n = scalar(@files); - $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, $n)); + my ($archive, $error, $ok); + if ($c->param('archive_type') eq 'zip') { + $archive = uniqueName('', scalar(@files) == 1 ? $files[0] . '.zip' : "$c->{courseName}.zip"); + $ok = zip [@files_to_compress] => $archive; + $error = $ZipError unless $ok; + } else { + $archive = uniqueName('', (scalar(@files) == 1) ? $files[0] . '.tgz' : "$c->{courseName}.tgz"); + $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files_to_compress); + $error = $Archive::Tar::error unless $ok; + } + if ($ok) { + my $n = scalar(@files_to_compress); + $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant, _2, file])', $archive, $n)); } else { - $c->addbadmessage( - $c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, systemError($?))); + $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); } return $c->Refresh; } @@ -379,23 +395,16 @@ sub UnpackArchive ($c) { } sub unpack_archive ($c, $archive) { - my $dir = "$c->{courseRoot}/$c->{pwd}"; - my @files; - if ($archive =~ m/\.zip$/) { - my $unzip = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{unzip} -u " . shell_quote($archive); - @files = readpipe "$unzip"; - } else { - my $z = $archive =~ m/\.tar$/ ? '' : 'z'; - my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); - @files = readpipe "$tar 2>&1"; - } + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $arch = Archive::Extract->new(archive => "$dir/$archive"); + my $ok = $arch->extract(to => $dir); - if ($? == 0) { - my $n = scalar(@files); + if ($ok) { + my $n = scalar(@{ $arch->files }); $c->addgoodmessage($c->maketext('[quant,_1,file] unpacked successfully', $n)); return 1; } else { - $c->addbadmessage($c->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, systemError($?))); + $c->addbadmessage($c->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, $arch->error)); return 0; } } diff --git a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep index e7c5db0ac6..b2efa10aec 100644 --- a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep @@ -40,7 +40,15 @@ <%= submit_button maketext('Download'), id => 'Download', %button =%> <%= submit_button maketext('Rename'), id => 'Rename', %button =%> <%= submit_button maketext('Copy'), id => 'Copy', %button =%> - <%= submit_button maketext('Delete'), id => 'Delete', %button =%>\ + <%= submit_button maketext('Delete'), id => 'Delete', %button =%> +
+ <%= label_for archive_type => maketext('Archive Type'), class => 'col-auto col-form-label fw-bold' =%> +
+ <%= select_field archive_type => [ [ 'Zip File' => 'zip'], ['Compressed Tar' => 'tgz'] ], + id => 'archive-type', + class => 'form-select', + =%> +
<%= submit_button maketext('Make Archive'), id => 'MakeArchive', data => { archive_text => maketext('Make Archive'), From f5182e80f6b4ad12d8a0635f640c0137a6efcfd2 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Thu, 10 Aug 2023 17:51:06 -0400 Subject: [PATCH 05/49] update check_modules and add new UI for archive This adds Archive::Extract to check_modules.pl and libarchive-extract-perl to docker files. In addition, the UI now has a secondary page for creating an archive. ran perltidy --- Dockerfile | 1 + DockerfileStage1 | 1 + bin/check_modules.pl | 1 + htdocs/js/FileManager/filemanager.js | 17 +++++ .../Instructor/FileManager.pm | 52 +++++++++------- .../Instructor/FileManager/archive.html.ep | 62 +++++++++++++++++++ .../Instructor/FileManager/refresh.html.ep | 8 --- 7 files changed, 112 insertions(+), 30 deletions(-) create mode 100644 templates/ContentGenerator/Instructor/FileManager/archive.html.ep diff --git a/Dockerfile b/Dockerfile index 349bb61816..c8e32b0d9d 100644 --- a/Dockerfile +++ b/Dockerfile @@ -71,6 +71,7 @@ RUN apt-get update \ imagemagick \ iputils-ping \ jq \ + libarchive-extract-perl \ libarchive-zip-perl \ libarray-utils-perl \ libc6-dev \ diff --git a/DockerfileStage1 b/DockerfileStage1 index d468ec0785..a844eab55e 100644 --- a/DockerfileStage1 +++ b/DockerfileStage1 @@ -33,6 +33,7 @@ RUN apt-get update \ imagemagick \ iputils-ping \ jq \ + libarchive-extract-perl \ libarchive-zip-perl \ libarray-utils-perl \ libc6-dev \ diff --git a/bin/check_modules.pl b/bin/check_modules.pl index e27900f784..b4261f51a8 100755 --- a/bin/check_modules.pl +++ b/bin/check_modules.pl @@ -65,6 +65,7 @@ =head1 DESCRIPTION ); my @modulesList = qw( + Archive::Extract Archive::Zip Array::Utils Benchmark diff --git a/htdocs/js/FileManager/filemanager.js b/htdocs/js/FileManager/filemanager.js index 5a55c529e4..e7e72552bc 100644 --- a/htdocs/js/FileManager/filemanager.js +++ b/htdocs/js/FileManager/filemanager.js @@ -42,6 +42,23 @@ } }; + // Used for the archive subpage to highlight all in the Select + const selectAllButton = document.getElementById('select-all-files-button'); + selectAllButton?.addEventListener('click', () => { + const n = document.getElementById('archive-files').options.length; + for (const opt of document.getElementById('archive-files').options) { + opt.selected = 'selected'; + } + }); + + + for (const r of document.querySelectorAll('input[name="archive_type"]')) { + r.addEventListener('click', () => { + const suffix = document.querySelector('input[name="archive_type"]:checked').value; + document.getElementById('filename_suffix').innerText = '.' + suffix; + }); + } + files?.addEventListener('change', checkFiles); if (files) checkFiles(); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index c496122f2c..0638353c9a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -354,32 +354,40 @@ sub MakeArchive ($c) { $c->addbadmessage($c->maketext('You must select at least one file for the archive')); return $c->Refresh; } - my $dir = "$c->{courseRoot}/$c->{pwd}"; - chdir $dir; - my @files_to_compress; - for my $f (@files) { - push(@files_to_compress, glob("$f/**")) if -d $f; - push(@files_to_compress, $f) if -f $f; - } + my $dir = "$c->{courseRoot}/$c->{pwd}"; + if ($c->param('confirmed')) { + chdir($dir); + # remove any directories + my @files_to_compress = grep { -f $_ } @files; + + unless ($c->param('archive_filename') && scalar(@files_to_compress) > 0) { + $c->addbadmessage($c->maketext('The filename cannot be empty.')) unless $c->param('archive_filename'); + $c->addbadmessage($c->maketext('At least one file must be selected')) unless scalar(@files_to_compress) > 0; + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } - my ($archive, $error, $ok); - if ($c->param('archive_type') eq 'zip') { - $archive = uniqueName('', scalar(@files) == 1 ? $files[0] . '.zip' : "$c->{courseName}.zip"); - $ok = zip [@files_to_compress] => $archive; - $error = $ZipError unless $ok; - } else { - $archive = uniqueName('', (scalar(@files) == 1) ? $files[0] . '.tgz' : "$c->{courseName}.tgz"); - $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files_to_compress); - $error = $Archive::Tar::error unless $ok; - } - if ($ok) { - my $n = scalar(@files_to_compress); - $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant, _2, file])', $archive, $n)); + my $archive = $c->param('archive_filename'); + my ($error, $ok); + if ($c->param('archive_type') eq 'zip') { + $archive .= '.zip'; + $ok = zip \@files_to_compress => $archive; + $error = $ZipError unless $ok; + } else { + $archive .= '.tgz'; + $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files_to_compress); + $error = $Archive::Tar::error unless $ok; + } + if ($ok) { + my $n = scalar(@files); + $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, $n)); + } else { + $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); + } + return $c->Refresh; } else { - $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); } - return $c->Refresh; } # Unpack a gzipped tar archive diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep new file mode 100644 index 0000000000..f70061c8ed --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -0,0 +1,62 @@ +% # template for the archive subpage. +
+
+
+ <%= maketext('The following files have been selected for archiving. Select the type ' + . 'of archive and any subset of the requested files.') =%> +
+
+
+
+ <%= maketext('Archive Filename') %>: + <%= text_field archive_filename => '', + 'aria-labelledby' => 'archive_filename', placeholder => maketext('Archive Filename'), + class => 'form-control', size => 30 =%> + .zip +
+
+
+
+
+ <%= maketext('Archive Type') %>: +
+ + + +
+
+
+ + + % my @files_to_compress; + % chdir($dir); + % for my $f (@$files) { + % push(@files_to_compress, glob("$f/**")) if -d $f; + % push(@files_to_compress, $f) if -f $f; + % } + % # remove any directories + % @files_to_compress = grep { -f $_ } @files_to_compress; + + <%= select_field files => \@files_to_compress, + id => 'archive-files', + class => 'form-select', + size => 20, + multiple => undef + =%> + +

<%= maketext('Create the archive of the select files?') %>

+
+ <%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> + <%= submit_button maketext('Make Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%> +
+
+
+<%= $c->HiddenFlags =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep index b2efa10aec..ee2f28562c 100644 --- a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep @@ -41,14 +41,6 @@ <%= submit_button maketext('Rename'), id => 'Rename', %button =%> <%= submit_button maketext('Copy'), id => 'Copy', %button =%> <%= submit_button maketext('Delete'), id => 'Delete', %button =%> -
- <%= label_for archive_type => maketext('Archive Type'), class => 'col-auto col-form-label fw-bold' =%> -
- <%= select_field archive_type => [ [ 'Zip File' => 'zip'], ['Compressed Tar' => 'tgz'] ], - id => 'archive-type', - class => 'form-select', - =%> -
<%= submit_button maketext('Make Archive'), id => 'MakeArchive', data => { archive_text => maketext('Make Archive'), From 7c829e6b601d5291de032a556ca278df96fb1eb9 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 15 Aug 2023 18:50:19 -0500 Subject: [PATCH 06/49] Fixes and improvements for the new "Make Archive" page. Fix the action. There needs to be a hidden "confirm" input. Improve layouts. Also other clean up suggested in my review of #2163. Don't use `chdir`. The IO::Compression::Zip module is too limited. It can not add directories to the zip file. Empty directories in particular should be. So use Archive::Zip instead. This module is already in use by webwork as well. --- htdocs/js/FileManager/filemanager.js | 18 +++---- .../Instructor/FileManager.pm | 53 ++++++++++++++----- .../Instructor/FileManager/archive.html.ep | 52 +++++++++--------- .../Instructor/FileManager/refresh.html.ep | 4 +- 4 files changed, 76 insertions(+), 51 deletions(-) diff --git a/htdocs/js/FileManager/filemanager.js b/htdocs/js/FileManager/filemanager.js index e7e72552bc..40d17ddc40 100644 --- a/htdocs/js/FileManager/filemanager.js +++ b/htdocs/js/FileManager/filemanager.js @@ -43,19 +43,17 @@ }; // Used for the archive subpage to highlight all in the Select - const selectAllButton = document.getElementById('select-all-files-button'); - selectAllButton?.addEventListener('click', () => { - const n = document.getElementById('archive-files').options.length; - for (const opt of document.getElementById('archive-files').options) { - opt.selected = 'selected'; + document.getElementById('select-all-files-button')?.addEventListener('click', () => { + for (const option of document.getElementById('archive-files').options) { + option.selected = 'selected'; } }); - - for (const r of document.querySelectorAll('input[name="archive_type"]')) { - r.addEventListener('click', () => { - const suffix = document.querySelector('input[name="archive_type"]:checked').value; - document.getElementById('filename_suffix').innerText = '.' + suffix; + for (const archiveTypeInput of document.querySelectorAll('input[name="archive_type"]')) { + archiveTypeInput.addEventListener('click', () => { + document.getElementById('filename_suffix').innerText = `.${ + document.querySelector('input[name="archive_type"]:checked').value + }`; }); } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 0638353c9a..b5336da263 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -27,8 +27,8 @@ use File::Copy; use File::Spec; use String::ShellQuote; use Archive::Extract; -use IO::Compress::Zip qw(zip $ZipError); use Archive::Tar; +use Archive::Zip qw(:ERROR_CODES); use WeBWorK::Utils qw(readDirectory readFile sortByName listFilesRecursive); use WeBWorK::Upload; @@ -356,14 +356,18 @@ sub MakeArchive ($c) { } my $dir = "$c->{courseRoot}/$c->{pwd}"; + if ($c->param('confirmed')) { - chdir($dir); - # remove any directories - my @files_to_compress = grep { -f $_ } @files; + my $action = $c->param('action') || 'Cancel'; + return $c->Refresh if $action eq 'Cancel' || $action eq $c->maketext('Cancel'); - unless ($c->param('archive_filename') && scalar(@files_to_compress) > 0) { - $c->addbadmessage($c->maketext('The filename cannot be empty.')) unless $c->param('archive_filename'); - $c->addbadmessage($c->maketext('At least one file must be selected')) unless scalar(@files_to_compress) > 0; + unless ($c->param('archive_filename')) { + $c->addbadmessage($c->maketext('The filename cannot be empty.')); + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } + + unless (@files > 0) { + $c->addbadmessage($c->maketext('At least one file must be selected')); return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); } @@ -371,18 +375,39 @@ sub MakeArchive ($c) { my ($error, $ok); if ($c->param('archive_type') eq 'zip') { $archive .= '.zip'; - $ok = zip \@files_to_compress => $archive; - $error = $ZipError unless $ok; + my $zip = Archive::Zip->new(); + for (@files) { + my $fullFile = "$dir/$_"; + + # Skip symbolic links for now. As of yet, I have not found a perl module that can add symbolic links to + # zip files correctly. Archive::Zip should be able to do this, but has permissions issues doing so. + next if -l $fullFile; + + if (-d $fullFile) { + $zip->addDirectory($fullFile => $_); + } else { + $zip->addFile($fullFile => $_); + } + } + $ok = $zip->writeToFileNamed("$dir/$archive") == AZ_OK; + # FIXME: This should check the error code, and give a more specific error message. + $error = 'Unable to create zip archive.' unless $ok; } else { $archive .= '.tgz'; - $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files_to_compress); - $error = $Archive::Tar::error unless $ok; + my $tar = Archive::Tar->new; + $tar->add_files(map {"$dir/$_"} @files); + # Make file names in the archive relative to the current working directory. + for ($tar->get_files) { + $tar->rename($_->full_path, $_->full_path =~ s!^$dir/!!r); + } + $ok = $tar->write("$dir/$archive", COMPRESS_GZIP); + $error = $tar->error unless $ok; } if ($ok) { - my $n = scalar(@files); - $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, $n)); + $c->addgoodmessage( + $c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, scalar(@files))); } else { - $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); + $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": [_2]}, $archive, $error)); } return $c->Refresh; } else { diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index f70061c8ed..0e1b0d3bcc 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -1,12 +1,13 @@ -% # template for the archive subpage. -
+% use Mojo::File qw(path); +% +
<%= maketext('The following files have been selected for archiving. Select the type ' - . 'of archive and any subset of the requested files.') =%> + . 'of archive and any subset of the requested files.') =%>
-
+
<%= maketext('Archive Filename') %>: <%= text_field archive_filename => '', @@ -20,38 +21,38 @@
<%= maketext('Archive Type') %>:
-
- - +
+
+ +
+
+ % % my @files_to_compress; - % chdir($dir); - % for my $f (@$files) { - % push(@files_to_compress, glob("$f/**")) if -d $f; - % push(@files_to_compress, $f) if -f $f; + % for my $file (@$files) { + % push(@files_to_compress, $file); + % my $path = path("$dir/$file"); + % push(@files_to_compress, @{ $path->list_tree({ hidden => 1 })->map('to_rel', $dir) }) + % if (-d $path && !-l $path); % } - % # remove any directories - % @files_to_compress = grep { -f $_ } @files_to_compress; - - <%= select_field files => \@files_to_compress, - id => 'archive-files', - class => 'form-select', - size => 20, - multiple => undef - =%> - + % + % # Select all files initially. Even those that are in previously selected directories or subdirectories. + % param('files', \@files_to_compress); + <%= select_field files => \@files_to_compress, id => 'archive-files', class => 'form-select mb-2', + size => 20, multiple => undef =%> + %

<%= maketext('Create the archive of the select files?') %>

<%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> @@ -59,4 +60,5 @@
+<%= hidden_field confirmed => 'MakeArchive' =%> <%= $c->HiddenFlags =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep index ee2f28562c..42f1053130 100644 --- a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep @@ -34,7 +34,7 @@ dir => 'ltr', size => 17, multiple => undef =%>
-
+
<%= submit_button maketext('View'), id => 'View', %button =%> <%= submit_button maketext('Edit'), id => 'Edit', %button =%> <%= submit_button maketext('Download'), id => 'Download', %button =%> @@ -50,7 +50,7 @@ % unless ($c->{courseName} eq 'admin') { <%= submit_button maketext('Archive Course'), id => 'ArchiveCourse', %button =%> % } -
+
<%= submit_button maketext('New File'), id => 'NewFile', %button =%> <%= submit_button maketext('New Folder'), id => 'NewFolder', %button =%> <%= submit_button maketext('Refresh'), id => 'Refresh', %button =%> From b90a4663036fadcfde576f41ae74d0b76e90dd27 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Aug 2023 11:02:13 -0500 Subject: [PATCH 07/49] Switch to using the Archive::Zip::SimpleZip module for creating zip archives. This modules supports symbolic links. --- Dockerfile | 2 +- DockerfileStage1 | 2 +- bin/check_modules.pl | 1 + .../Instructor/FileManager.pm | 30 ++++++------------- .../Instructor/FileManager/archive.html.ep | 2 +- 5 files changed, 13 insertions(+), 24 deletions(-) diff --git a/Dockerfile b/Dockerfile index c8e32b0d9d..f735e07e69 100644 --- a/Dockerfile +++ b/Dockerfile @@ -185,7 +185,7 @@ RUN apt-get update \ # ================================================================== # Phase 4 - Install additional Perl modules from CPAN that are not packaged for Ubuntu or are outdated in Ubuntu. -RUN cpanm install Statistics::R::IO DBD::MariaDB Mojo::SQLite@3.002 Perl::Tidy@20220613 \ +RUN cpanm install Statistics::R::IO DBD::MariaDB Mojo::SQLite@3.002 Perl::Tidy@20220613 Archive::Zip::SimpleZip \ && rm -fr ./cpanm /root/.cpanm /tmp/* # ================================================================== diff --git a/DockerfileStage1 b/DockerfileStage1 index a844eab55e..85357f3597 100644 --- a/DockerfileStage1 +++ b/DockerfileStage1 @@ -147,7 +147,7 @@ RUN apt-get update \ # ================================================================== # Phase 3 - Install additional Perl modules from CPAN that are not packaged for Ubuntu or are outdated in Ubuntu. -RUN cpanm install -n Statistics::R::IO DBD::MariaDB Mojo::SQLite@3.002 Perl::Tidy@20220613 \ +RUN cpanm install -n Statistics::R::IO DBD::MariaDB Mojo::SQLite@3.002 Perl::Tidy@20220613 Archive::Zip::SimpleZip \ && rm -fr ./cpanm /root/.cpanm /tmp/* # ================================================================== diff --git a/bin/check_modules.pl b/bin/check_modules.pl index b4261f51a8..bbb72196f5 100755 --- a/bin/check_modules.pl +++ b/bin/check_modules.pl @@ -67,6 +67,7 @@ =head1 DESCRIPTION my @modulesList = qw( Archive::Extract Archive::Zip + Archive::Zip::SimpleZip Array::Utils Benchmark Carp diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index b5336da263..e3acf6185f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -28,7 +28,7 @@ use File::Spec; use String::ShellQuote; use Archive::Extract; use Archive::Tar; -use Archive::Zip qw(:ERROR_CODES); +use Archive::Zip::SimpleZip qw($SimpleZipError); use WeBWorK::Utils qw(readDirectory readFile sortByName listFilesRecursive); use WeBWorK::Upload; @@ -355,7 +355,7 @@ sub MakeArchive ($c) { return $c->Refresh; } - my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $dir = $c->{pwd} eq '.' ? $c->{courseRoot} : "$c->{courseRoot}/$c->{pwd}"; if ($c->param('confirmed')) { my $action = $c->param('action') || 'Cancel'; @@ -375,23 +375,13 @@ sub MakeArchive ($c) { my ($error, $ok); if ($c->param('archive_type') eq 'zip') { $archive .= '.zip'; - my $zip = Archive::Zip->new(); - for (@files) { - my $fullFile = "$dir/$_"; - - # Skip symbolic links for now. As of yet, I have not found a perl module that can add symbolic links to - # zip files correctly. Archive::Zip should be able to do this, but has permissions issues doing so. - next if -l $fullFile; - - if (-d $fullFile) { - $zip->addDirectory($fullFile => $_); - } else { - $zip->addFile($fullFile => $_); + if (my $zip = Archive::Zip::SimpleZip->new("$dir/$archive")) { + for (@files) { + $zip->add("$dir/$_", Name => $_, storelinks => 1); } + $ok = $zip->close; } - $ok = $zip->writeToFileNamed("$dir/$archive") == AZ_OK; - # FIXME: This should check the error code, and give a more specific error message. - $error = 'Unable to create zip archive.' unless $ok; + $error = $SimpleZipError unless $ok; } else { $archive .= '.tgz'; my $tar = Archive::Tar->new; @@ -430,11 +420,9 @@ sub UnpackArchive ($c) { sub unpack_archive ($c, $archive) { my $dir = "$c->{courseRoot}/$c->{pwd}"; my $arch = Archive::Extract->new(archive => "$dir/$archive"); - my $ok = $arch->extract(to => $dir); - if ($ok) { - my $n = scalar(@{ $arch->files }); - $c->addgoodmessage($c->maketext('[quant,_1,file] unpacked successfully', $n)); + if ($arch->extract(to => $dir)) { + $c->addgoodmessage($c->maketext('[quant,_1,file] unpacked successfully', scalar(@{ $arch->files }))); return 1; } else { $c->addbadmessage($c->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, $arch->error)); diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index 0e1b0d3bcc..ba544384c9 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -44,7 +44,7 @@ % for my $file (@$files) { % push(@files_to_compress, $file); % my $path = path("$dir/$file"); - % push(@files_to_compress, @{ $path->list_tree({ hidden => 1 })->map('to_rel', $dir) }) + % push(@files_to_compress, @{ $path->list_tree({ dir => 1, hidden => 1 })->map('to_rel', $dir) }) % if (-d $path && !-l $path); % } % From e7b1b0a9b8f4ec3c83e4f08f15711299aab5fa94 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 16 Aug 2023 17:37:40 -0400 Subject: [PATCH 08/49] Changes selecting files to Mojo::File and other fixes. --- .../Instructor/FileManager.pm | 87 +++++++++---------- .../Instructor/FileManager.html.ep | 1 + .../Instructor/FileManager/archive.html.ep | 2 +- 3 files changed, 43 insertions(+), 47 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index e3acf6185f..d7c965ed34 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -25,6 +25,7 @@ WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manage use File::Path; use File::Copy; use File::Spec; +use Mojo::File; use String::ShellQuote; use Archive::Extract; use Archive::Tar; @@ -347,62 +348,56 @@ sub Delete ($c) { } } -# Make a gzipped tar or zip archive +# Call the make archive template. sub MakeArchive ($c) { my @files = $c->param('files'); if (scalar(@files) == 0) { $c->addbadmessage($c->maketext('You must select at least one file for the archive')); return $c->Refresh; + } else { + return $c->include( + 'ContentGenerator/Instructor/FileManager/archive', + dir => "$c->{courseRoot}/$c->{pwd}", + files => \@files + ); } +} - my $dir = $c->{pwd} eq '.' ? $c->{courseRoot} : "$c->{courseRoot}/$c->{pwd}"; - - if ($c->param('confirmed')) { - my $action = $c->param('action') || 'Cancel'; - return $c->Refresh if $action eq 'Cancel' || $action eq $c->maketext('Cancel'); - - unless ($c->param('archive_filename')) { - $c->addbadmessage($c->maketext('The filename cannot be empty.')); - return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); - } - - unless (@files > 0) { - $c->addbadmessage($c->maketext('At least one file must be selected')); - return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); - } +# Create either a gzipped tar or zip archive. +sub CreateArchive ($c) { + my @files = $c->param('files'); + my $dir = "$c->{courseRoot}/$c->{pwd}"; + + # Save the current working directory and change to the $path directory. + my $cwd = Mojo::File->new; + chdir($dir); + unless ($c->param('archive_filename') && scalar(@files) > 0) { + $c->addbadmessage($c->maketext('The filename cannot be empty.')) unless $c->param('archive_filename'); + $c->addbadmessage($c->maketext('At least one file must be selected')) unless scalar(@files) > 0; + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } - my $archive = $c->param('archive_filename'); - my ($error, $ok); - if ($c->param('archive_type') eq 'zip') { - $archive .= '.zip'; - if (my $zip = Archive::Zip::SimpleZip->new("$dir/$archive")) { - for (@files) { - $zip->add("$dir/$_", Name => $_, storelinks => 1); - } - $ok = $zip->close; - } - $error = $SimpleZipError unless $ok; - } else { - $archive .= '.tgz'; - my $tar = Archive::Tar->new; - $tar->add_files(map {"$dir/$_"} @files); - # Make file names in the archive relative to the current working directory. - for ($tar->get_files) { - $tar->rename($_->full_path, $_->full_path =~ s!^$dir/!!r); - } - $ok = $tar->write("$dir/$archive", COMPRESS_GZIP); - $error = $tar->error unless $ok; - } - if ($ok) { - $c->addgoodmessage( - $c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, scalar(@files))); - } else { - $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": [_2]}, $archive, $error)); - } - return $c->Refresh; + my $archive = $c->param('archive_filename'); + my ($error, $ok); + if ($c->param('archive_type') eq 'zip') { + $archive .= '.zip'; + $ok = zip \@files => $archive; + $error = $ZipError unless $ok; } else { - return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + $archive .= '.tgz'; + $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files); + $error = $Archive::Tar::error unless $ok; + } + if ($ok) { + my $n = scalar(@files); + $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, $n)); + } else { + $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); } + + # Change the working directory back to the original working directory. + chdir($cwd); + return $c->Refresh; } # Unpack a gzipped tar archive diff --git a/templates/ContentGenerator/Instructor/FileManager.html.ep b/templates/ContentGenerator/Instructor/FileManager.html.ep index e10aa557be..fd6406c9c6 100644 --- a/templates/ContentGenerator/Instructor/FileManager.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager.html.ep @@ -44,6 +44,7 @@ % x('Make Archive') => 'MakeArchive', % x('Unpack Archive') => 'UnpackArchive', % x('Archive Course') => 'Refresh', + % x('Create Archive') => 'CreateArchive' % ); % % # Add translated action names to the method map. diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index ba544384c9..ee5aab8c24 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -56,7 +56,7 @@

<%= maketext('Create the archive of the select files?') %>

<%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> - <%= submit_button maketext('Make Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%> + <%= submit_button maketext('Create Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%>
From c854a71288456a4e64aa7a567883d824d067bdfc Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 16 Aug 2023 16:48:13 -0500 Subject: [PATCH 09/49] Fix the broken stuff. --- .../Instructor/FileManager.pm | 32 +------------------ .../Instructor/FileManager.html.ep | 1 - .../Instructor/FileManager/archive.html.ep | 2 +- 3 files changed, 2 insertions(+), 33 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index d7c965ed34..827899dd36 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -25,7 +25,6 @@ WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manage use File::Path; use File::Copy; use File::Spec; -use Mojo::File; use String::ShellQuote; use Archive::Extract; use Archive::Tar; @@ -348,20 +347,13 @@ sub Delete ($c) { } } -# Call the make archive template. +# Make a gzipped tar or zip archive sub MakeArchive ($c) { my @files = $c->param('files'); if (scalar(@files) == 0) { $c->addbadmessage($c->maketext('You must select at least one file for the archive')); return $c->Refresh; - } else { - return $c->include( - 'ContentGenerator/Instructor/FileManager/archive', - dir => "$c->{courseRoot}/$c->{pwd}", - files => \@files - ); } -} # Create either a gzipped tar or zip archive. sub CreateArchive ($c) { @@ -376,28 +368,6 @@ sub CreateArchive ($c) { $c->addbadmessage($c->maketext('At least one file must be selected')) unless scalar(@files) > 0; return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); } - - my $archive = $c->param('archive_filename'); - my ($error, $ok); - if ($c->param('archive_type') eq 'zip') { - $archive .= '.zip'; - $ok = zip \@files => $archive; - $error = $ZipError unless $ok; - } else { - $archive .= '.tgz'; - $ok = Archive::Tar->create_archive($archive, COMPRESS_GZIP, @files); - $error = $Archive::Tar::error unless $ok; - } - if ($ok) { - my $n = scalar(@files); - $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, $n)); - } else { - $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, $error)); - } - - # Change the working directory back to the original working directory. - chdir($cwd); - return $c->Refresh; } # Unpack a gzipped tar archive diff --git a/templates/ContentGenerator/Instructor/FileManager.html.ep b/templates/ContentGenerator/Instructor/FileManager.html.ep index fd6406c9c6..e10aa557be 100644 --- a/templates/ContentGenerator/Instructor/FileManager.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager.html.ep @@ -44,7 +44,6 @@ % x('Make Archive') => 'MakeArchive', % x('Unpack Archive') => 'UnpackArchive', % x('Archive Course') => 'Refresh', - % x('Create Archive') => 'CreateArchive' % ); % % # Add translated action names to the method map. diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index ee5aab8c24..ba544384c9 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -56,7 +56,7 @@

<%= maketext('Create the archive of the select files?') %>

<%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> - <%= submit_button maketext('Create Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%> + <%= submit_button maketext('Make Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%>
From 9b38a068e2e2760a0f328b121c55e2af2282b628 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Thu, 24 Aug 2023 14:42:28 -0400 Subject: [PATCH 10/49] Tweaks to the file manager make archive page. If the chose archvie file exists, then don't blindly overwrite it. Add a checkbox to that allows the user to select to overwrite the file. Only replace the existing archive file if that checkbox is checked. Otherwise show a message that the file exists, and don't overwrite. If a single file is selected (or single directory initially selected) then use that filename (without extension) for a default for the archive name. --- .../Instructor/FileManager.pm | 64 +++++++++++++++---- .../Instructor/FileManager/archive.html.ep | 18 +++++- 2 files changed, 68 insertions(+), 14 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 827899dd36..5c054d33de 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -355,17 +355,59 @@ sub MakeArchive ($c) { return $c->Refresh; } -# Create either a gzipped tar or zip archive. -sub CreateArchive ($c) { - my @files = $c->param('files'); - my $dir = "$c->{courseRoot}/$c->{pwd}"; - - # Save the current working directory and change to the $path directory. - my $cwd = Mojo::File->new; - chdir($dir); - unless ($c->param('archive_filename') && scalar(@files) > 0) { - $c->addbadmessage($c->maketext('The filename cannot be empty.')) unless $c->param('archive_filename'); - $c->addbadmessage($c->maketext('At least one file must be selected')) unless scalar(@files) > 0; + my $dir = $c->{pwd} eq '.' ? $c->{courseRoot} : "$c->{courseRoot}/$c->{pwd}"; + + if ($c->param('confirmed')) { + my $action = $c->param('action') || 'Cancel'; + return $c->Refresh if $action eq 'Cancel' || $action eq $c->maketext('Cancel'); + + unless ($c->param('archive_filename')) { + $c->addbadmessage($c->maketext('The filename cannot be empty.')); + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } + + unless (@files > 0) { + $c->addbadmessage($c->maketext('At least one file must be selected')); + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } + + my $archive = $c->param('archive_filename') . '.' . $c->param('archive_type'); + + if (-e "$dir/$archive" && !$c->param('overwrite')) { + $c->addbadmessage($c->maketext( + 'The file [_1] exists. Check "Overwrite existing archive" to force this file to be replaced.', + $archive + )); + return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); + } + + my ($error, $ok); + if ($c->param('archive_type') eq 'zip') { + if (my $zip = Archive::Zip::SimpleZip->new("$dir/$archive")) { + for (@files) { + $zip->add("$dir/$_", Name => $_, storelinks => 1); + } + $ok = $zip->close; + } + $error = $SimpleZipError unless $ok; + } else { + my $tar = Archive::Tar->new; + $tar->add_files(map {"$dir/$_"} @files); + # Make file names in the archive relative to the current working directory. + for ($tar->get_files) { + $tar->rename($_->full_path, $_->full_path =~ s!^$dir/!!r); + } + $ok = $tar->write("$dir/$archive", COMPRESS_GZIP); + $error = $tar->error unless $ok; + } + if ($ok) { + $c->addgoodmessage( + $c->maketext('Archive "[_1]" created successfully ([quant,_2,file])', $archive, scalar(@files))); + } else { + $c->addbadmessage($c->maketext(q{Can't create archive "[_1]": [_2]}, $archive, $error)); + } + return $c->Refresh; + } else { return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); } } diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index ba544384c9..2fdf389ee5 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -1,6 +1,6 @@ % use Mojo::File qw(path); % -
+
<%= maketext('The following files have been selected for archiving. Select the type ' @@ -10,7 +10,7 @@
<%= maketext('Archive Filename') %>: - <%= text_field archive_filename => '', + <%= text_field archive_filename => @$files == 1 ? $files->[0] =~ s/\..*$//r : '', 'aria-labelledby' => 'archive_filename', placeholder => maketext('Archive Filename'), class => 'form-control', size => 30 =%> .zip @@ -32,6 +32,18 @@
+
+
+
+
+ +
+
+
+
-
-
% % my @files_to_compress; % for my $file (@$files) { diff --git a/templates/HelpFiles/InstructorFileManager.html.ep b/templates/HelpFiles/InstructorFileManager.html.ep index bf2ecb0fb5..a99ad49b76 100644 --- a/templates/HelpFiles/InstructorFileManager.html.ep +++ b/templates/HelpFiles/InstructorFileManager.html.ep @@ -20,8 +20,8 @@ <%= maketext('This allows for the viewing, downloading, uploading and other management ' . 'of files in the course. Select a file or set of files (using CTRL or SHIFT) and click ' . 'the desired button on the right. Many actions can only be done with a single file (like ' - . 'view). Selecting a directory or set of files and clicking "Make Archive" creates a compressed ' - . 'tar file with the name COURSE_NAME.tgz' ) =%> + . 'view). Selecting a directory or set of files and clicking "Make Archive" allows the creation ' + . 'of a compressed tar or zip file.') =%>

<%= maketext('The list of files include regular files, directories (ending in a "/") ' From 3e4a523d0e21b65ebc79c7efd743f7e87bfc4a9c Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Fri, 25 Aug 2023 13:52:52 -0400 Subject: [PATCH 12/49] Switch archive type from radio button to select --- .../Instructor/FileManager/archive.html.ep | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index 5e2ac8cc49..2f95188b22 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -13,22 +13,7 @@ <%= text_field archive_filename => @$files == 1 ? $files->[0] =~ s/\..*$//r : 'webwork_files', 'aria-labelledby' => 'archive_filename', placeholder => maketext('Archive Filename'), class => 'form-control', size => 30 =%> - .zip -

-
-
-
-
- <%= maketext('Archive Type') %>: -
- - + <%= select_field archive_type => ['zip', 'tgz'], class => 'form-select' =%>
From 8e302d952e0fd8378cb678b7903b1933c84d7a63 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Sun, 27 Aug 2023 20:25:10 -0400 Subject: [PATCH 13/49] Some accessibility changes to the archive type select --- htdocs/js/FileManager/filemanager.js | 8 -------- .../Instructor/FileManager/archive.html.ep | 17 +++++++++++------ 2 files changed, 11 insertions(+), 14 deletions(-) diff --git a/htdocs/js/FileManager/filemanager.js b/htdocs/js/FileManager/filemanager.js index e85e7da509..5a55c529e4 100644 --- a/htdocs/js/FileManager/filemanager.js +++ b/htdocs/js/FileManager/filemanager.js @@ -42,14 +42,6 @@ } }; - for (const archiveTypeInput of document.querySelectorAll('input[name="archive_type"]')) { - archiveTypeInput.addEventListener('click', () => { - document.getElementById('filename_suffix').innerText = `.${ - document.querySelector('input[name="archive_type"]:checked').value - }`; - }); - } - files?.addEventListener('change', checkFiles); if (files) checkFiles(); diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index 2f95188b22..76059dc5c2 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -2,18 +2,23 @@ %
-
+
<%= maketext('The following files have been selected for archiving. Select the type ' . 'of archive and any subset of the requested files.') =%>
- <%= maketext('Archive Filename') %>: + <%= text_field archive_filename => @$files == 1 ? $files->[0] =~ s/\..*$//r : 'webwork_files', - 'aria-labelledby' => 'archive_filename', placeholder => maketext('Archive Filename'), + id => 'archive-filename', placeholder => maketext('Archive Filename'), class => 'form-control', size => 30 =%> - <%= select_field archive_type => ['zip', 'tgz'], class => 'form-select' =%> + <%= select_field archive_type => [ + [ 'File Type' => '', disabled => undef, id => 'archive-type-label' ], + [ '.zip' => 'zip', selected => undef ], + [ '.tgz' => 'tgz' ] + ], + class => 'form-select', style => 'max-width: 7em', 'aria-labelledby' => 'archive-type-label' =%>
@@ -41,9 +46,9 @@ % # Select all files initially. Even those that are in previously selected directories or subdirectories. % param('files', \@files_to_compress) unless param('confirmed'); <%= select_field files => \@files_to_compress, id => 'archive-files', class => 'form-select mb-2', - size => 20, multiple => undef =%> + 'arialabelled-by' => 'files-label', size => 20, multiple => undef =%> % -

<%= maketext('Create the archive of the select files?') %>

+

<%= maketext('Create archive of the selected files?') %>

<%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> <%= submit_button maketext('Make Archive'), name => 'action', class => 'btn btn-sm btn-primary' =%> From 43b82fea60dbb0f070e70f67438ff7d0b574d501 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Mon, 28 Aug 2023 15:45:07 -0400 Subject: [PATCH 14/49] Add text-end to archive file name input, File Type -> Archive Type and wrap in maketext --- .../ContentGenerator/Instructor/FileManager/archive.html.ep | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index 76059dc5c2..b9ac245c13 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -12,9 +12,9 @@ <%= text_field archive_filename => @$files == 1 ? $files->[0] =~ s/\..*$//r : 'webwork_files', id => 'archive-filename', placeholder => maketext('Archive Filename'), - class => 'form-control', size => 30 =%> + class => 'form-control text-end', size => 30 =%> <%= select_field archive_type => [ - [ 'File Type' => '', disabled => undef, id => 'archive-type-label' ], + [ maketext('Archive Type') => '', disabled => undef, id => 'archive-type-label' ], [ '.zip' => 'zip', selected => undef ], [ '.tgz' => 'tgz' ] ], From 3dd549601821cd8330055385f7af191e8bad3901 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 28 Aug 2023 16:55:54 -0500 Subject: [PATCH 15/49] Change the way that the archive type is determined. This adds a "By extension" option to the archive type dropdown which is the default option. If that option is selected, then the archive type will be determined by the extension given in the file name. If the file name does not have a valid archive extension, then the zip archive type is assumed and that extension is added. If zip or tar is selected then the zip or tgz extension is added to the filename (if it doesn't already have that extension), and of course that archive type is used. Note that describes the server side behavior. Javascript also changes the extension in the input client side. Note that the `.tar.gz` extension is also supported if explicitly given for the filename extension. Note that at or above the large breakpoint the archive type dropdown and "Overwrite existing archive" checkbox will be on the second line together. Below the large breakpoint, they will be on separate lines. Also `dir="ltr"` is added to both the archive filename input and the files select. Also remove the "Create archive of the selected files?" question. The presented answers are not valid for that question, and the question isn't needed with the instructions at the top, as well as the fact that the buttons are clear as to what they will do. --- htdocs/js/FileManager/filemanager.js | 13 +++++++++ .../Instructor/FileManager.pm | 15 +++++++++-- .../Instructor/FileManager/archive.html.ep | 27 +++++++++++-------- 3 files changed, 42 insertions(+), 13 deletions(-) diff --git a/htdocs/js/FileManager/filemanager.js b/htdocs/js/FileManager/filemanager.js index 5a55c529e4..02c3a50aa8 100644 --- a/htdocs/js/FileManager/filemanager.js +++ b/htdocs/js/FileManager/filemanager.js @@ -45,6 +45,19 @@ files?.addEventListener('change', checkFiles); if (files) checkFiles(); + const archiveFilenameInput = document.getElementById('archive-filename'); + const archiveTypeSelect = document.getElementById('archive-type'); + if (archiveFilenameInput && archiveTypeSelect) { + archiveTypeSelect.addEventListener('change', () => { + if (archiveTypeSelect.value) { + archiveFilenameInput.value = archiveFilenameInput.value.replace( + /\.(zip|tgz|tar.gz)$/, + `.${archiveTypeSelect.value}` + ); + } + }); + } + const file = document.getElementById('file'); const uploadButton = document.getElementById('Upload'); const checkFile = () => (uploadButton.disabled = file.value === ''); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 5c054d33de..80efa6d973 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -371,7 +371,18 @@ sub MakeArchive ($c) { return $c->include('ContentGenerator/Instructor/FileManager/archive', dir => $dir, files => \@files); } - my $archive = $c->param('archive_filename') . '.' . $c->param('archive_type'); + my $archive_type = + $c->param('archive_type') || ($c->param('archive_filename') =~ /\.(zip|tgz|tar.gz)$/ ? $1 : 'zip'); + + my $archive = $c->param('archive_filename'); + + # Add the correct extension to the archive filename unless it already has it. If the extension for + # the other archive type is given, then change it to the extension for this archive type. + if ($archive_type eq 'zip') { + $archive =~ s/(\.(tgz|tar.gz))?$/.zip/ unless $archive =~ /\.zip$/; + } else { + $archive =~ s/(\.zip)?$/.tgz/ unless $archive =~ /\.(tgz|tar.gz)$/; + } if (-e "$dir/$archive" && !$c->param('overwrite')) { $c->addbadmessage($c->maketext( @@ -382,7 +393,7 @@ sub MakeArchive ($c) { } my ($error, $ok); - if ($c->param('archive_type') eq 'zip') { + if ($archive_type eq 'zip') { if (my $zip = Archive::Zip::SimpleZip->new("$dir/$archive")) { for (@files) { $zip->add("$dir/$_", Name => $_, storelinks => 1); diff --git a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep index b9ac245c13..fa4f637ac0 100644 --- a/templates/ContentGenerator/Instructor/FileManager/archive.html.ep +++ b/templates/ContentGenerator/Instructor/FileManager/archive.html.ep @@ -10,20 +10,26 @@
- <%= text_field archive_filename => @$files == 1 ? $files->[0] =~ s/\..*$//r : 'webwork_files', + <%= text_field archive_filename => + @$files == 1 ? $files->[0] =~ s/\..*$/.zip/r : 'webwork_files.zip', id => 'archive-filename', placeholder => maketext('Archive Filename'), - class => 'form-control text-end', size => 30 =%> - <%= select_field archive_type => [ - [ maketext('Archive Type') => '', disabled => undef, id => 'archive-type-label' ], - [ '.zip' => 'zip', selected => undef ], - [ '.tgz' => 'tgz' ] - ], - class => 'form-select', style => 'max-width: 7em', 'aria-labelledby' => 'archive-type-label' =%> + class => 'form-control', size => 30, dir => 'ltr' =%>
-
+
+
+ + <%= select_field archive_type => [ + [ maketext('By extension') => '', selected => undef ], + [ 'zip' => 'zip' ], + [ 'tar' => 'tgz' ] + ], + class => 'form-select', id => 'archive-type' =%> +
+
+