Switch to using the Archive::Zip::SimpleZip module for creating zip a…

…rchives. This modules supports symbolic links.
drgrice1 · Aug 16, 2023 · 764125f · 764125f
1 parent 41d605e
commit 764125f
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 18 deletions.
diff --git 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
@@ -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;

diff --git 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);
 		% }
 		%