X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=8a426987bf2fbb90614f7f36620aaf37cbbcaae2;hb=30e800d975f1d75656094b37303dcc62facda9a5;hp=04954424d41c41a0f143898431e042584204db76;hpb=98da70a27673e32530c404401d3e2c6dff3fcde4;p=pr0n diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index 0495442..8a42698 100644 --- a/perl/Sesse/pr0n/Common.pm +++ b/perl/Sesse/pr0n/Common.pm @@ -22,6 +22,7 @@ use HTML::Entities; use URI::Escape; use File::Basename; use Crypt::Eksblowfish::Bcrypt; +use File::Temp; BEGIN { use Exporter (); @@ -212,10 +213,10 @@ sub get_disk_location { } sub get_cache_location { - my ($id, $width, $height) = @_; + my ($id, $width, $height, $format) = @_; my $dir = POSIX::floor($id / 256); - return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-nobox.jpg"; + return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-nobox.$format"; } sub get_infobox_cache_location { @@ -527,17 +528,9 @@ sub read_original_image { } my $err; - # ImageMagick can handle NEF files, but it does it by calling dcraw as a delegate. - # The delegate support is rather broken and causes very odd stuff to happen when - # more than one thread does this at the same time. Thus, we simply do it ourselves. if ($filename =~ /\.(nef|cr2)$/i) { - # this would suffice if ImageMagick gets to fix their handling - # $physical_fname = "NEF:$physical_fname"; - - open DCRAW, "-|", "dcraw", "-w", "-c", $physical_fname - or error("dcraw: $!"); - $err = $magick->Read(file => \*DCRAW); - close(DCRAW); + $physical_fname = "NEF:$physical_fname"; + $err = $magick->Read($physical_fname); } else { # We always want YCbCr JPEGs. Setting this explicitly here instead of using # RGB is slightly faster (no colorspace conversion needed) and works equally @@ -572,14 +565,26 @@ sub read_original_image { } sub ensure_cached { - my ($r, $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); } - my $cachename = get_cache_location($id, $xres, $yres); + # 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, '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'); + } + + $cachename = get_cache_location($id, $xres, $yres, 'jpg'); if (! -r $cachename or (-M $cachename > -M $fname)) { # If we are in overload mode (aka Slashdot mode), refuse to generate # new thumbnails. @@ -588,14 +593,14 @@ sub ensure_cached { error($r, 'System is in overload mode, not doing any scaling'); } - make_cache($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres); + make_cache($r, $filename, $id, $dbwidth, $dbheight, 'jpg', $xres, $yres, @otherres); } return ($cachename, 'image/jpeg'); } sub make_cache { - my ($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_; + my ($r, $filename, $id, $dbwidth, $dbheight, $format, $xres, $yres, @otherres) = @_; my ($img, $new_dbwidth, $new_dbheight) = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres); @@ -608,7 +613,7 @@ sub make_cache { my $err; while (defined($xres) && defined($yres)) { my ($nxres, $nyres) = (shift @otherres, shift @otherres); - my $cachename = get_cache_location($id, $xres, $yres); + my $cachename = get_cache_location($id, $xres, $yres, $format); my $cimg; if (defined($nxres) && defined($nyres)) { @@ -634,7 +639,7 @@ sub make_cache { # Strip EXIF tags etc. $cimg->Strip(); - { + if ($format eq 'jpg') { my %parms = ( filename => $cachename, quality => $quality @@ -647,13 +652,49 @@ sub make_cache { $parms{'sampling-factor'} = $sf; } $err = $cimg->write(%parms); + } elsif ($format eq 'avif') { + # ImageMagick doesn't have AVIF support until version 7, + # and Debian hasn't packaged that even in unstable as of 2021. + # So we'll need to do it the manual way. (We don't use /tmp, for security reasons.) + (my $dirname = $cachename) =~ s,/[^/]*$,,; + my ($fh, $raw_filename) = File::Temp::tempfile('tmp.XXXXXXXX', DIR => $dirname, SUFFIX => '.ycbcr'); + # Write a Y4M header, so that we get the chroma range correct. + printf $fh "YUV4MPEG2 W%d H%d F25:1 Ip A1:1 C444 XYSCSS=444 XCOLORRANGE=FULL\nFRAME\n", $nwidth, $nheight; + my %parms = ( + file => $fh, + filename => $raw_filename, + interlace => 'Plane' + ); + $cimg->write(%parms); + close($fh); + my $ivf_filename; + ($fh, $ivf_filename) = File::Temp::tempfile('tmp.XXXXXXXX', DIR => $dirname, SUFFIX => '.ivf'); + close($fh); + system('aomenc', '--quiet', '--cpu-used=0', '--bit-depth=10', '--end-usage=q', '--cq-level=13', '--target-bitrate=0', '--good', '--aq-mode=1', '--matrix-coefficients=bt601', '-o', $ivf_filename, $raw_filename); + 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"; } undef $cimg; ($xres, $yres) = ($nxres, $nyres); - log_info($r, "New cache: $nwidth x $nheight for $id.jpg"); + log_info($r, "New cache: $nwidth x $nheight ($format) for $id"); } undef $img;