X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=101cee6283603405dfcc5830dd9e277e837a0613;hb=78229c85e0965be553209569da657ffb0a35366e;hp=f6cea5b98ab8e9de7721decb63f167707eea8e43;hpb=c7fd47d6b2323d28a5ece7f3019b40224605cb61;p=pr0n

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index f6cea5b..101cee6 100644
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -219,17 +219,6 @@ sub get_cache_location {
 	return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-nobox.$format";
 }
 
-sub get_infobox_cache_location {
-	my ($id, $width, $height, $dpr) = @_;
-	my $dir = POSIX::floor($id / 256);
-
-	if ($dpr == 1) {
-		return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-box.png";
-	} else {
-		return $Sesse::pr0n::Config::image_base . "cache/$dir/$id-$width-$height-box\@$dpr.png";
-	}
-}
-
 sub ensure_disk_location_exists {
 	my ($r, $id) = @_;
 	my $dir = POSIX::floor($id / 256);
@@ -237,13 +226,15 @@ sub ensure_disk_location_exists {
 	my $img_dir = $Sesse::pr0n::Config::image_base . "/images/$dir/";
 	if (! -d $img_dir) {
 		log_info($r, "Need to create new image directory $img_dir");
-		mkdir($img_dir) or die "Couldn't create new image directory $img_dir";
+		mkdir($img_dir);  # Ignore errors, there could be a race.
+		-d $img_dir or die "Couldn't create new image directory $img_dir";
 	}
 
 	my $cache_dir = $Sesse::pr0n::Config::image_base . "/cache/$dir/";
 	if (! -d $cache_dir) {
 		log_info($r, "Need to create new cache directory $cache_dir");
-		mkdir($cache_dir) or die "Couldn't create new image directory $cache_dir";
+		mkdir($cache_dir);  # Ignore errors, there could be a race.
+		-d $cache_dir or die "Couldn't create new cache directory $cache_dir";
 	}
 }
 
@@ -528,17 +519,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
@@ -573,16 +556,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 +665,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";
 		}
@@ -699,69 +699,6 @@ sub make_cache {
 	}
 }
 
-sub ensure_infobox_cached {
-	my ($r, $filename, $id, $dbwidth, $dbheight, $dpr, $xres, $yres) = @_;
-
-	my ($new_dbwidth, $new_dbheight);
-
-	my $fname = get_disk_location($r, $id);
-	my $cachename = get_infobox_cache_location($id, $xres, $yres, $dpr);
-	my $err;
-	if (! -r $cachename or (-M $cachename > -M $fname)) {
-		# If we are in overload mode (aka Slashdot mode), refuse to generate
-		# new thumbnails.
-		if (Sesse::pr0n::Overload::is_in_overload($r)) {
-			log_warn($r, "In overload mode, not scaling $id to $xres x $yres");
-			error($r, 'System is in overload mode, not doing any scaling');
-		}
-
-		# We need the exact width so we can make one in the right size.
-		my ($width, $height);
-
-		# This is slow, but should fortunately almost never happen, so don't bother
-		# special-casing it.
-		if (!defined($dbwidth) || !defined($dbheight)) {
-			my $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, 0);
-			$new_dbwidth = $width = $img->Get('columns');
-			$new_dbheight = $height = $img->Get('rows');
-		} else {
-			$width = $dbwidth;
-			$height = $dbheight;
-		}
-		my $img = Image::Magick->new;
-
-		if (defined($xres) && defined($yres)) {
-			($width, $height) = scale_aspect($width, $height, $xres, $yres);
-		}
-		$height = 24 * $dpr;
-		$img->Set(size=>($width . "x" . $height));
-		$img->Read('xc:white');
-
-		my $info = Image::ExifTool::ImageInfo($fname);
-		if (make_infobox($img, $info, $r, $dpr)) {
-			$img->Quantize(colors=>16, dither=>'False');
-
-			# Since the image is grayscale, ImageMagick overrides us and writes this
-			# as grayscale anyway, but at least we get rid of the alpha channel this
-			# way.
-			$img->Set(type=>'Palette');
-		} else {
-			# Not enough room for the text, make a tiny dummy transparent infobox
-			@$img = ();
-			$img->Set(size=>"1x1");
-			$img->Read('null:');
-
-			$width = 1;
-			$height = 1;
-		}
-
-		$err = $img->write(filename => $cachename, quality => 90, depth => 8);
-		log_info($r, "New infobox cache: $width x $height for $id.jpg");
-	}
-
-	return ($cachename, 'image/png');
-}
-
 sub get_mimetype_from_filename {
 	my $filename = shift;
 	my MIME::Type $type = $mimetypes->mimeTypeOf($filename);
@@ -769,8 +706,8 @@ sub get_mimetype_from_filename {
 	return $type;
 }
 
-sub make_infobox {
-	my ($img, $info, $r, $dpr) = @_;
+sub make_infobox_parts {
+	my ($info) = @_;
 
 	# The infobox is of the form
 	# "Time - date - focal length, shutter time, aperture, sensitivity, exposure bias - flash",
@@ -885,57 +822,7 @@ sub make_infobox {
 		}
 	}
 
-	return 0 if (scalar @parts == 0);
-
-	# Find the required width
-	my $th = 0;
-	my $tw = 0;
-
-	for my $part (@parts) {
-		my $font;
-		if ($part->[1]) {
-			$font = '/usr/share/fonts/truetype/msttcorefonts/Arial_Bold.ttf';
-		} else {
-			$font = '/usr/share/fonts/truetype/msttcorefonts/Arial.ttf';
-		}
-
-		my (undef, undef, $h, undef, $w) = ($img->QueryFontMetrics(text=>$part->[0], font=>$font, pointsize=>12*$dpr));
-
-		$tw += $w;
-		$th = $h if ($h > $th);
-	}
-
-	return 0 if ($tw > $img->Get('columns'));
-
-	my $x = 0;
-	my $y = $img->Get('rows') - 24*$dpr;
-
-	# Hit exact DCT blocks
-	$y -= ($y % 8);
-
-	my $points = sprintf "%u,%u %u,%u", $x, $y, ($img->Get('columns') - 1), ($img->Get('rows') - 1);
-	my $lpoints = sprintf "%u,%u %u,%u", $x, $y, ($img->Get('columns') - 1), $y;
-	$img->Draw(primitive=>'rectangle', stroke=>'white', fill=>'white', points=>$points);
-	$img->Draw(primitive=>'line', stroke=>'black', strokewidth=>$dpr, points=>$lpoints);
-
-	# Start writing out the text
-	$x = ($img->Get('columns') - $tw) / 2;
-
-	my $room = ($img->Get('rows') - $dpr - $y - $th);
-	$y = ($img->Get('rows') - $dpr) - $room/2;
-	
-	for my $part (@parts) {
-		my $font;
-		if ($part->[1]) {
-			$font = '/usr/share/fonts/truetype/msttcorefonts/Arial_Bold.ttf';
-		} else {
-			$font = '/usr/share/fonts/truetype/msttcorefonts/Arial.ttf';
-		}
-		$img->Annotate(text=>$part->[0], font=>$font, pointsize=>12*$dpr, x=>int($x), y=>int($y));
-		$x += ($img->QueryFontMetrics(text=>$part->[0], font=>$font, pointsize=>12*$dpr))[4];
-	}
-
-	return 1;
+	return @parts;
 }
 
 sub gcd {
@@ -1039,10 +926,6 @@ sub get_all_cache_urls {
 			push @ret, "/$event/$1x$2/$filename";
 		} elsif ($fname =~ /^$id-(\d+)-(\d+)-nobox\.jpg$/) {
 			push @ret, "/$event/$1x$2/nobox/$filename";
-		} elsif ($fname =~ /^$id--1--1-box\.png$/) {
-			push @ret, "/$event/box/$filename";
-		} elsif ($fname =~ /^$id-(\d+)-(\d+)-box\.png$/) {
-			push @ret, "/$event/$1x$2/box/$filename";
 		} else {
 			log_warn($r, "Couldn't find a purging URL for $fname");
 		}