From c305a42e2491a0f998938e02f61c4456b8cb5d5d Mon Sep 17 00:00:00 2001
From: "Steinar H. Gunderson" <sgunderson@bigfoot.com>
Date: Sat, 5 Jun 2021 23:29:55 +0200
Subject: [PATCH] Split out the cache generation from the up-to-date testing.

---
 perl/Sesse/pr0n/Common.pm | 122 ++++++++++++++++++++------------------
 1 file changed, 64 insertions(+), 58 deletions(-)

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 4839285..f071afc 100644
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -580,7 +580,6 @@ sub ensure_cached {
 	}
 
 	my $cachename = get_cache_location($id, $xres, $yres);
-	my $err;
 	if (! -r $cachename or (-M $cachename > -M $fname)) {
 		# If we are in overload mode (aka Slashdot mode), refuse to generate
 		# new thumbnails.
@@ -589,76 +588,83 @@ sub ensure_cached {
 			error($r, 'System is in overload mode, not doing any scaling');
 		}
 
-		my ($img, $new_dbwidth, $new_dbheight) = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
+		make_cache($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
+	}
 
-		# Update the SQL database if it doesn't contain the required info
-		if (!defined($dbwidth) && defined($new_dbwidth)) {
-			log_info($r, "Updating width/height for $id: $new_dbwidth x $new_dbheight");
-			update_image_info($r, $id, $new_dbwidth, $new_dbheight);
-		}
+	return ($cachename, 'image/jpeg');
+}
 
-		while (defined($xres) && defined($yres)) {
-			my ($nxres, $nyres) = (shift @otherres, shift @otherres);
-			my $cachename = get_cache_location($id, $xres, $yres);
-			
-			my $cimg;
-			if (defined($nxres) && defined($nyres)) {
-				# we have more resolutions to scale, so don't throw
-				# the image away
-				$cimg = $img->Clone();
-			} else {
-				$cimg = $img;
-			}
+sub make_cache {
+	my ($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres) = @_;
+
+	my ($img, $new_dbwidth, $new_dbheight) = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
+
+	# Update the SQL database if it doesn't contain the required info
+	if (!defined($dbwidth) && defined($new_dbwidth)) {
+		log_info($r, "Updating width/height for $id: $new_dbwidth x $new_dbheight");
+		update_image_info($r, $id, $new_dbwidth, $new_dbheight);
+	}
+
+	my $err;
+	while (defined($xres) && defined($yres)) {
+		my ($nxres, $nyres) = (shift @otherres, shift @otherres);
+		my $cachename = get_cache_location($id, $xres, $yres);
 		
-			my $width = $img->Get('columns');
-			my $height = $img->Get('rows');
-			my ($nwidth, $nheight) = scale_aspect($width, $height, $xres, $yres);
+		my $cimg;
+		if (defined($nxres) && defined($nyres)) {
+			# we have more resolutions to scale, so don't throw
+			# the image away
+			$cimg = $img->Clone();
+		} else {
+			$cimg = $img;
+		}
+	
+		my $width = $img->Get('columns');
+		my $height = $img->Get('rows');
+		my ($nwidth, $nheight) = scale_aspect($width, $height, $xres, $yres);
 
-			my $filter = 'Lanczos';
-			my $quality = 87;
-			my $sf = "1x1";
+		my $filter = 'Lanczos';
+		my $quality = 87;
+		my $sf = "1x1";
 
-			if ($xres != -1) {
-				$cimg->Resize(width=>$nwidth, height=>$nheight, filter=>$filter);
-			}
+		if ($xres != -1) {
+			$cimg->Resize(width=>$nwidth, height=>$nheight, filter=>$filter);
+		}
 
-			# Strip EXIF tags etc.
-			$cimg->Strip();
+		# Strip EXIF tags etc.
+		$cimg->Strip();
 
-			{
-				my %parms = (
-					filename => $cachename,
-					quality => $quality
-				);
-				if (($nwidth >= 640 && $nheight >= 480) ||
-				    ($nwidth >= 480 && $nheight >= 640)) {
-				    	$parms{'interlace'} = 'Plane';
-				}
-				if (defined($sf)) {
-					$parms{'sampling-factor'} = $sf;
-				}
-				$err = $cimg->write(%parms);
+		{
+			my %parms = (
+				filename => $cachename,
+				quality => $quality
+			);
+			if (($nwidth >= 640 && $nheight >= 480) ||
+			    ($nwidth >= 480 && $nheight >= 640)) {
+				$parms{'interlace'} = 'Plane';
+			}
+			if (defined($sf)) {
+				$parms{'sampling-factor'} = $sf;
 			}
+			$err = $cimg->write(%parms);
+		}
 
-			undef $cimg;
+		undef $cimg;
 
-			($xres, $yres) = ($nxres, $nyres);
+		($xres, $yres) = ($nxres, $nyres);
 
-			log_info($r, "New cache: $nwidth x $nheight for $id.jpg");
-		}
-		
-		undef $img;
-		if ($err) {
-			log_warn($r, "$fname: $err");
-			$err =~ /(\d+)/;
-			if ($1 >= 400) {
-				#@$magick = ();
-				error($r, "$fname: $err");
-			}
+		log_info($r, "New cache: $nwidth x $nheight for $id.jpg");
+	}
+	
+	undef $img;
+	if ($err) {
+		log_warn($r, "$filename: $err");
+		$err =~ /(\d+)/;
+		if ($1 >= 400) {
+			#@$magick = ();
+			error($r, "$filename: $err");
 		}
 	}
-
-	return ($cachename, 'image/jpeg');
 }
 
 sub ensure_infobox_cached {
-- 
2.39.2