Support JPEG XL, like AVIF.

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index f6cea5b98ab8e9de7721decb63f167707eea8e43..816c003cb016eac4d55b11d3dde730ceb89b19bf 100644 (file)
--- 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 13d9ee5e3ae488d6cf7f9393fa589240c34ab0d5..8671b570693e8504fca4c0d83aca04bd03c90e30 100644 (file)
--- 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 2db57091ac5c1d498cf698011c8ada58fb654102..0c5b70882d056340eab0dfdaf1d1662dbc321f70 100755 (executable)
--- 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);
        }       
 }