Eliminated Archive::Extract in favor of Archive::Tar and some other c…

…leanup.
pstaabp · Nov 10, 2023 · 2166fe6 · 2166fe6
1 parent 825bffc
commit 2166fe6
Show file tree

Hide file tree

Showing 5 changed files with 38 additions and 29 deletions.
diff --git a/bin/check_modules.pl b/bin/check_modules.pl
@@ -65,6 +65,7 @@ =head1 DESCRIPTION
 );
 
 my @modulesList = qw(
+	Archive::Tar
 	Archive::Zip
 	Archive::Zip::SimpleZip
 	Array::Utils

diff --git a/bin/download-OPL-metadata-release.pl b/bin/download-OPL-metadata-release.pl
@@ -9,7 +9,7 @@
 use File::Fetch;
 use File::Copy;
 use File::Path;
-use Archive::Extract;
+use Archive::Tar;
 use Mojo::File;
 use JSON;
 
@@ -54,9 +54,11 @@ BEGIN
 my $releaseFile       = $releaseDownloadFF->fetch(to => $ce->{webworkDirs}{tmp}) or die $releaseDownloadFF->error;
 say 'Downloaded release archive, now extracting.';
 
-my $arch = Archive::Extract->new(archive => "$releaseFile");
-my $ok   = $arch->extract(to => $ce->{webworkDirs}{tmp});
-die "There was an error extracting the release: $arch->error" unless $ok;
+my $arch = Archive::Tar->new($releaseFile);
+die "An error occurred while creating the tar file: $releaseFile" unless $arch;
+$arch->setcwd($path);
+$arch->extract();
+die "There was an error extracting the metadata release: $arch->error" if $arch->error;
 
 # Copy the json files into htdocs.
 for (glob("$ce->{webworkDirs}{tmp}/webwork-open-problem-library/JSON-SAVED/*.json")) {

diff --git a/lib/HardcopyRenderedProblem.pm b/lib/HardcopyRenderedProblem.pm
@@ -28,6 +28,7 @@ use warnings;
 
 use File::Path;
 use String::ShellQuote;
+use Archive::Zip;
 use Archive::Zip::SimpleZip qw($SimpleZipError);
 use Mojo::File qw(path tempdir);
 use XML::LibXML;
@@ -172,14 +173,17 @@ sub generate_hardcopy_tex {
 	push(@$errors, "Failed to generate error log file: $@")                                     if $@;
 
 	# Create a zip archive of the bundle directory
-	my $zip;
-	eval {
-		$zip = Archive::Zip::SimpleZip->new($working_dir->dirname->child('hardcopy.zip')->to_string);
-		$zip->add($working_dir->dirname->to_string, storelinks => 1);
-	};
-	push(@$errors, $@) if $@;
-	push(@$errors, qq{Failed to create zip archive of directory "$working_dir": $SimpleZipError}) unless ($zip->close);
+	my $zip = Archive::Zip::SimpleZip->new($working_dir->child('hardcopy.zip')->to_string);
+	unless ($zip) {
+		push(@$errors, "Failed to make a zip file at " . $working_dir->child('hardcopy.zip')->to_string);
+		return;
+	}
 
+	$zip->add($working_dir->dirname->to_string, storelinks => 1);
+	unless ($zip->close) {
+		push(@$errors, "Failed to create zip archive of directory '$working_dir': $SimpleZipError");
+		return;
+	}
 	return;
 }
 

diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm
@@ -736,16 +736,17 @@ sub generate_hardcopy_tex ($c, $temp_dir_path, $final_file_basename) {
 
 	# Create a zip archive of the bundle directory
 	my $zip_file = "$temp_dir_path/$final_file_basename.zip";
-	my $zip;
-	eval {
-		$zip = Archive::Zip::SimpleZip->new($zip_file);
-		$zip->add($temp_dir_path, Name => "hardcopy_files", StoreLink => 1);
-	};
+	$zip = Archive::Zip::SimpleZip->new($zip_file);
+	unless ($zip) {
+		$c->add_error('Failed to create zip archive of directory "', $c->tag('code', $bundle_path), '": $SimpleZipError"');
+		return;
+	}
 
-	$c->add_error('Failed to create zip archive of directory "', $c->tag('code', $bundle_path), '": $SimpleZipError"')
-		unless $zip->close;
-	$c->add_error('Failed to create zip archive of directory "', $c->tag('code', $bundle_path), '": $@') if $@;
-	return "$bundle_path/$src_name" if (!$zip->close || $@);
+	my $ok = $zip->add($temp_dir_path, Name => "hardcopy_files", StoreLink => 1);
+	unless ($ok) {
+		$c->add_error('Failed to create zip archive of directory "', $c->tag('code', $bundle_path), '": $SimpleZipError"');
+		return;
+	}
 
 	return $zip_file;
 }

diff --git a/lib/WeBWorK/Utils/CourseManagement.pm b/lib/WeBWorK/Utils/CourseManagement.pm
@@ -35,7 +35,6 @@ use File::Copy::Recursive qw(dircopy);
 use File::Spec;
 use Mojo::File;
 use Archive::Tar;
-use Archive::Extract;
 use WeBWorK::CourseEnvironment;
 use WeBWorK::DB;
 use WeBWorK::Debug;
@@ -357,8 +356,8 @@ sub addCourse {
 		if (exists $options{copySimpleConfig}) {
 			my $sourceFile = $sourceCE->{courseFiles}->{simpleConfig};
 			if (-e $sourceFile) {
-				my $copy_ok = copy($sourceFile, $ce->{courseFiles}{simpleConfig});
-				warn "Failed to copy simple.conf from course '$sourceCourse': $!" unless $copy_ok;
+				eval { Mojo::File->new($sourceFile)->copy_to($ce->{courseFiles}) };
+				warn "Failed to copy simple.conf from course '$sourceCourse': $@" if $@;
 			}
 		}
 
@@ -443,9 +442,8 @@ sub renameCourse {
 	##### step 1: move course directory #####
 
 	# move top-level course directory
-	eval { Mojo::File->new($oldCourseDir)->move_to($newCourseDir) };
 	debug("moving course dir from $oldCourseDir to $newCourseDir");
-
+	eval { Mojo::File->new($oldCourseDir)->move_to($newCourseDir) };
 	die "Failed to move course directory:  $@" if ($@);
 
 	# get new course environment
@@ -857,11 +855,14 @@ sub unarchiveCourse {
 
 	##### step 2: crack open the tarball #####
 
-	my $arch    = Archive::Extract->new(archive => $archivePath);
-	my $extr_ok = $arch->extract(to => $coursesDir);
-	unless ($extr_ok) {
+	my $arch = Archive::Tar->new($archivePath);
+	die "The tar file $archivePath is not valid." unless $arch;
+	$arch->setcwd($coursesDir);
+	$arch->extract();
+
+	if ($arch->error) {
 		_unarchiveCourse_move_back($restoreCourseData);
-		die "Failed to unarchive course directory for course $newCourseID: $!";
+		die "Failed to unarchive course directory for course $newCourseID: $arch->error";
 	}
 
 	##### step 3: read the course environment for this course #####