From a2d71665db6bf86f40ae9deb956cfc6463645529 Mon Sep 17 00:00:00 2001
From: "Steinar H. Gunderson" <sgunderson@bigfoot.com>
Date: Tue, 15 Jun 2021 23:55:45 +0200
Subject: [PATCH] Support JPEG XL, like AVIF.

---
 perl/Sesse/pr0n/Common.pm          | 23 ++++++++++++++++++++---
 perl/Sesse/pr0n/Image.pm           |  3 ++-
 perl/{make-avif.pl => make-jxl.pl} |  6 +++---
 3 files changed, 25 insertions(+), 7 deletions(-)
 rename perl/{make-avif.pl => make-jxl.pl} (92%)

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index f6cea5b..816c003 100644
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -573,16 +573,21 @@ sub read_original_image {
 }
 
 sub ensure_cached {
-	my ($r, $avif_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
+	my ($r, $avif_ok, $jxl_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
 
 	my $fname = get_disk_location($r, $id);
 	unless (defined($xres) && (!defined($dbwidth) || !defined($dbheight) || $xres < $dbwidth || $yres < $dbheight || $xres == -1)) {
 		return ($fname, undef);
 	}
 
-	# See if we have an up-to-date AVIF to serve.
+	# See if we have an up-to-date JPEG-XL or AVIF to serve.
 	# (We never generate them on-the-fly, since they're so slow.)
-	my $cachename = get_cache_location($id, $xres, $yres, 'avif');
+	my $cachename = get_cache_location($id, $xres, $yres, 'jxl');
+	if ($jxl_ok && -r $cachename and (-M $cachename <= -M $fname)) {
+		return ($cachename, 'image/jxl');
+	}
+
+	$cachename = get_cache_location($id, $xres, $yres, 'avif');
 	if ($avif_ok && -r $cachename and (-M $cachename <= -M $fname)) {
 		return ($cachename, 'image/avif');
 	}
@@ -677,6 +682,18 @@ sub make_cache {
 			unlink($raw_filename);
 			system('MP4Box', '-quiet', '-add-image', "$ivf_filename:primary", '-ab', 'avif', '-ab', 'miaf', '-new', $cachename);
 			unlink($ivf_filename);
+		} elsif ($format eq 'jxl') {
+			# Similar, for JPEG-XL.
+			(my $dirname = $cachename) =~ s,/[^/]*$,,;
+			my ($fh, $raw_filename) = File::Temp::tempfile('tmp.XXXXXXXX', DIR => $dirname, SUFFIX => '.ppm');
+			my %parms = (
+				file => $fh,
+				filename => $raw_filename
+			);
+			$cimg->write(%parms);
+			close($fh);
+			system('cjxl', '-p', $raw_filename, $cachename);
+			unlink($raw_filename);
 		} else {
 			die "Unknown format $format";
 		}
diff --git a/perl/Sesse/pr0n/Image.pm b/perl/Sesse/pr0n/Image.pm
index 13d9ee5..8671b57 100644
--- a/perl/Sesse/pr0n/Image.pm
+++ b/perl/Sesse/pr0n/Image.pm
@@ -67,7 +67,8 @@ sub handler {
 	} else {
 		my $accept = $r->header('Accept');
 		my $avif_ok = (defined($accept) && $accept =~ /(^|,)image\/avif($|,|;)/);
-		($fname, $mime_type) = Sesse::pr0n::Common::ensure_cached($r, $avif_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres);
+		my $jxl_ok = (defined($accept) && $accept =~ /(^|,)image\/jxl($|,|;)/);
+		($fname, $mime_type) = Sesse::pr0n::Common::ensure_cached($r, $avif_ok, $jxl_ok, $filename, $id, $dbwidth, $dbheight, $xres, $yres);
 		$res->header('Vary' => 'Accept');
 	}
 
diff --git a/perl/make-avif.pl b/perl/make-jxl.pl
similarity index 92%
rename from perl/make-avif.pl
rename to perl/make-jxl.pl
index 2db5709..0c5b708 100755
--- a/perl/make-avif.pl
+++ b/perl/make-jxl.pl
@@ -25,8 +25,8 @@ for my $id (@ARGV) {
 	for my $file (<$base/$id-*-nobox.jpg>) {   # TODO: --1--1.jpg, too.
 		my $fname = File::Basename::basename($file);
 		my ($width, $height) = $fname =~ /^$id-(\d+)-(\d+)-nobox\.jpg$/ or die $fname;
-		(my $avif_file = $file) =~ s/jpg$/avif/;
-		unless (-r $avif_file) {
+		(my $jxl_file = $file) =~ s/jpg$/jxl/;
+		unless (-r $jxl_file) {
 			push @res, ($width, $height);
 			print "$id to $width x $height...\n";
 		}
@@ -40,6 +40,6 @@ for my $id (@ARGV) {
 		$dbwidth = $ref->{'width'};
 		$dbheight = $ref->{'height'};
 
-		Sesse::pr0n::Common::make_cache({}, $filename, $id, $dbwidth, $dbheight, 'avif', @res);
+		Sesse::pr0n::Common::make_cache({}, $filename, $id, $dbwidth, $dbheight, 'jxl', @res);
 	}	
 }
-- 
2.39.2