From 1b9af31b158bdf14551d6a7551a3d42bca833810 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 5 Aug 2026 06:44:55 -0500 Subject: [PATCH] Cache course archives in the admin course archives directory. Anytime the `listArchivedCourses` method of the `WeBWorK::Utils::CourseManagement` package is called a cache of the course archive files in the admin course archives directory is created (if it does not exist) or updated (if new archive files are found, archive files are removed, or archive files are modified). Also, anytime a course archive is created and the archive file is stored in the archives directory of the admin course, the cache is updated. Note that when an archive file is added to the cache this way it is actually much faster than when it is added to the cache via the `listArchivedCourses` method since the tar archive does not need to be inspected at all (it was just created, so the course id is already known). Note that the `listArchivedCourses` approach for updating the cache for deleted archive files is really fast, so there is no need to handle that elsewhere. Unfortunately, if archive files are added or modified in other ways than creating a course archive via the `archiveCourse` method, there is no way to detect that. So the slow `listArchivedCourses` cache update is the only recourse. If there are only a few added archive files this is still relatively fast though. The archive cache is stored in the file `archives/archive-cache.json` in the admin course directory. The `listArchivedCourses` method is called when the "Course Listings" or "Unarchive Course" pages in the admin course are loaded. So if you have a lot of course archives in the admin course archives directory that are not yet cached, the load time will still be slow. However, once those archives are in the cache, the load time will be pretty much as fast as before. A `getHumanReadableFileSize` method was added to the `WeBWorK::Utils::Files` package since that is used both in the `listArchivedCourses` method and in the `archiveCourse` method, and might be useful elsewhere. --- lib/WeBWorK/Utils/CourseManagement.pm | 69 ++++++++++++++++++++------- lib/WeBWorK/Utils/Files.pm | 22 +++++++++ 2 files changed, 75 insertions(+), 16 deletions(-) diff --git a/lib/WeBWorK/Utils/CourseManagement.pm b/lib/WeBWorK/Utils/CourseManagement.pm index 581cf10d71..514d086132 100644 --- a/lib/WeBWorK/Utils/CourseManagement.pm +++ b/lib/WeBWorK/Utils/CourseManagement.pm @@ -15,6 +15,7 @@ use DBI; use String::ShellQuote; use UUID::Tiny qw(create_uuid_as_string); use Mojo::File qw(path); +use Mojo::JSON qw(decode_json encode_json); use File::Copy::Recursive qw(dircopy); use File::Spec; use Archive::Tar; @@ -23,7 +24,7 @@ use WeBWorK::Debug; use WeBWorK::CourseEnvironment; use WeBWorK::DB; use WeBWorK::Utils qw(runtime_use); -use WeBWorK::Utils::Files qw(surePathToFile); +use WeBWorK::Utils::Files qw(surePathToFile getHumanReadableFileSize); use WeBWorK::Utils::Instructor qw(assignSetsToUsers); our @EXPORT_OK = qw( @@ -125,24 +126,35 @@ including the .tar.gz extension) and file C. For example, sub listArchivedCourses { my ($ce) = @_; - my $archivesDir = path("$ce->{webworkDirs}{courses}/$ce->{admin_course_id}/archives"); + my $archivesDir = path($ce->{webworkDirs}{courses})->child($ce->{admin_course_id}, 'archives'); surePathToFile($ce->{webworkDirs}{courses}, "$archivesDir/test"); # Ensure archives directory exists. my $archives = $archivesDir->list->grep(qr/\.tar\.gz$/i); + my $archiveDataFile = $archivesDir->child('archive-cache.json'); + my $archiveData = eval { decode_json($archiveDataFile->slurp) } || {}; + + my $archiveDataUpdated = 0; my %return; for (@$archives) { - my $size = $_->stat->size; - my @units = qw(B KB MB GB); - my $unit_idx = 0; - while ($size >= 1024 && $unit_idx < $#units) { - $size /= 1024; - ++$unit_idx; + my $basename = $_->basename; + my $lastModified = $_->stat->mtime; + + if ($archiveData->{$basename} && $archiveData->{$basename}{lastModified} >= $lastModified) { + $return{ $archiveData->{$basename}{courseID} } = { + filename => $basename, + size => $archiveData->{$basename}{size} + } + if defined $archiveData->{$basename}{courseID}; + next; } - my $basename = $_->basename; - my $arch = Archive::Tar->new($_); + + $archiveDataUpdated = 1; + $archiveData->{$basename} = { lastModified => $lastModified }; + + my $archive = Archive::Tar->new($_); my %top_level; - for my $file ($arch->get_files) { + for my $file ($archive->get_files) { (my $first = $file->full_path) =~ s{/.*}{}s; $top_level{$first} = 1 if length $first; } @@ -151,12 +163,22 @@ sub listArchivedCourses { next; } my ($currCourseID) = keys %top_level; - my $round = 10**($unit_idx > 0 ? $unit_idx - 1 : 0); - $return{$currCourseID} = { - filename => $basename, - size => sprintf("%s %s", int($size * $round) / $round, $units[$unit_idx]) - }; + + $archiveData->{$basename}{courseID} = $currCourseID; + $archiveData->{$basename}{size} = getHumanReadableFileSize($_); + $return{$currCourseID} = { filename => $basename, size => $archiveData->{$basename}{size} }; } + + my %archives = map { $_->basename => 1 } @$archives; + for (keys %$archiveData) { + unless ($archives{$_}) { + delete $archiveData->{$_}; + $archiveDataUpdated = 1; + } + } + + $archiveDataFile->spew(encode_json($archiveData)) if $archiveDataUpdated; + return %return; } @@ -936,6 +958,21 @@ sub archiveCourse { } _archiveCourse_remove_dump_dir($ce, $dump_dir); + # Update the admin course archive cache if this is saved to the archives directory of the admin course. + if (-e $archive_path + && $archive_path eq "$ce->{webworkDirs}{courses}/$ce->{admin_course_id}/archives/$courseID.tar.gz") + { + my $archiveDataFile = + path($ce->{webworkDirs}{courses})->child($ce->{admin_course_id}, 'archives', 'archive-cache.json'); + my $archiveData = eval { decode_json($archiveDataFile->slurp) } || {}; + $archiveData->{"$courseID.tar.gz"} = { + courseID => $courseID, + size => getHumanReadableFileSize(path($archive_path)), + lastModified => time + }; + $archiveDataFile->spew(encode_json($archiveData)); + } + return $message; } diff --git a/lib/WeBWorK/Utils/Files.pm b/lib/WeBWorK/Utils/Files.pm index 911489fb7a..13787b9ae8 100644 --- a/lib/WeBWorK/Utils/Files.pm +++ b/lib/WeBWorK/Utils/Files.pm @@ -10,6 +10,7 @@ our @EXPORT_OK = qw( readFile listFilesRecursive path_is_subdir + getHumanReadableFileSize ); sub surePathToFile ($start_directory, $path) { @@ -93,6 +94,19 @@ sub path_is_subdir ($path, $dir, $allow_relative = 0) { return 1; } +sub getHumanReadableFileSize ($file) { + my $size = $file->stat->size; + my @units = qw(B KB MB GB); + my $unit_idx = 0; + while ($size >= 1024 && $unit_idx < $#units) { + $size /= 1024; + ++$unit_idx; + } + my $round = 10**($unit_idx > 0 ? $unit_idx - 1 : 0); + + return sprintf("%s %s", int($size * $round) / $round, $units[$unit_idx]); +} + 1; =head1 NAME @@ -145,4 +159,12 @@ prefix of it matches C<$dir>. If either of these checks fails, a false value is returned. Otherwise, a true value is returned. +=head2 getHumanReadableFileSize + + getHumanReadableFileSize($file) + +Returns the human readable size (the size with the appropriate unit of C, +C, C, or C) of a C<$file> where C<$file> is a C object. +Note that this method assumes the passed C<$file> exists and is readable. + =cut