X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=00fa9e9b0c42213676fc70707955ba8a9a696988;hp=027268a2c469faeeb2b5d232d91e619753a8b341;hb=4c67de43660ea5ee7077ab8c2c6b787471901a71;hpb=133c9fb7f197da55e8b85e98a17ae6a184a28832

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 027268a..00fa9e9 100644
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -2,8 +2,9 @@ package Sesse::pr0n::Common;
 use strict;
 use warnings;
 
-use Sesse::pr0n::Templates;
 use Sesse::pr0n::Overload;
+use Sesse::pr0n::QscaleProxy;
+use Sesse::pr0n::Templates;
 
 use Apache2::RequestRec (); # for $r->content_type
 use Apache2::RequestIO ();  # for $r->print
@@ -35,7 +36,7 @@ BEGIN {
 		require Sesse::pr0n::Config_local;
 	};
 
-	$VERSION     = "v2.60";
+	$VERSION     = "v2.70";
 	@ISA         = qw(Exporter);
 	@EXPORT      = qw(&error &dberror);
 	%EXPORT_TAGS = qw();
@@ -379,12 +380,14 @@ sub stat_image_from_id {
 # Takes in an image ID and a set of resolutions, and returns (generates if needed)
 # the smallest mipmap larger than the largest of them.
 sub make_mipmap {
-	my ($r, $filename, $id, $dbwidth, $dbheight, @res) = @_;
+	my ($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale, @res) = @_;
 	my ($img, $mmimg, $width, $height);
+	
+	my $physical_fname = get_disk_location($r, $id);
 
 	# If we don't know the size, we'll need to read it in anyway
 	if (!defined($dbwidth) || !defined($dbheight)) {
-		$img = read_original_image($r, $id, $dbwidth, $dbheight);
+		$img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale);
 		$width = $img->Get('columns');
 		$height = $img->Get('rows');
 	} else {
@@ -408,7 +411,7 @@ sub make_mipmap {
 		my $large_enough = 1;
 		for my $i (0..($#res/2)) {
 			my ($xres, $yres) = ($res[$i*2], $res[$i*2+1]);
-			if ($xres > $new_mmwidth || $yres > $new_mmheight) {
+			if ($xres == -1 || $xres > $new_mmwidth || $yres > $new_mmheight) {
 				$large_enough = 0;
 				last;
 			}
@@ -429,13 +432,17 @@ sub make_mipmap {
 		my $mmres = $mmlist[$i];
 
 		my $mmlocation = get_mipmap_location($r, $id, $mmres->[0], $mmres->[1]);
-		if (! -r $mmlocation or (-M $mmlocation > -M $filename)) {
+		if (! -r $mmlocation or (-M $mmlocation > -M $physical_fname)) {
 			if (!defined($img)) {
 				if (defined($last_good_mmlocation)) {
-					$img = Image::Magick->new;
+					if ($can_use_qscale) {
+						$img = Sesse::pr0n::QscaleProxy->new;
+					} else {
+						$img = Image::Magick->new;
+					}
 					$img->Read($last_good_mmlocation);
 				} else {
-					$img = read_original_image($r, $id, $dbwidth, $dbheight);
+					$img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale);
 				}
 			}
 			my $cimg;
@@ -445,7 +452,7 @@ sub make_mipmap {
 				$cimg = $img->Clone();
 			}
 			$r->log->info("Making mipmap for $id: " . $mmres->[0] . " x " . $mmres->[1]);
-			$cimg->Resize(width=>$mmres->[0], height=>$mmres->[1], filter=>'Lanczos');
+			$cimg->Resize(width=>$mmres->[0], height=>$mmres->[1], filter=>'Lanczos', 'sampling-factor'=>'1x1');
 			$cimg->Strip();
 			my $err = $cimg->write(
 				filename => $mmlocation,
@@ -458,34 +465,43 @@ sub make_mipmap {
 		}
 		if ($last && !defined($img)) {
 			# OK, read in the smallest one
-			$img = Image::Magick->new;
+			if ($can_use_qscale) {
+				$img = Sesse::pr0n::QscaleProxy->new;
+			} else {
+				$img = Image::Magick->new;
+			}
 			my $err = $img->Read($mmlocation);
 		}
 	}
 
 	if (!defined($img)) {
-		$img = read_original_image($r, $id, $dbwidth, $dbheight);
+		$img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale);
 	}
 	return $img;
 }
 
 sub read_original_image {
-	my ($r, $id, $dbwidth, $dbheight) = @_;
+	my ($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale) = @_;
 
-	my $fname = get_disk_location($r, $id);
+	my $physical_fname = get_disk_location($r, $id);
 
 	# Read in the original image
-	my $magick = new Image::Magick;
+	my $magick;
+	if ($can_use_qscale && ($filename =~ /\.jpeg$/i || $filename =~ /\.jpg$/i)) {
+		$magick = Sesse::pr0n::QscaleProxy->new;
+	} else {
+		$magick = Image::Magick->new;
+	}
 	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 ($fname =~ /\.nef$/i) {
+	if ($filename =~ /\.(nef|cr2)$/i) {
 		# this would suffice if ImageMagick gets to fix their handling
-		# $fname = "NEF:$fname";
+		# $physical_fname = "NEF:$physical_fname";
 		
-		open DCRAW, "-|", "dcraw", "-w", "-c", $fname
+		open DCRAW, "-|", "dcraw", "-w", "-c", $physical_fname
 			or error("dcraw: $!");
 		$err = $magick->Read(file => \*DCRAW);
 		close(DCRAW);
@@ -499,20 +515,25 @@ sub read_original_image {
 		#if (!$infobox) {
 		#	$magick->Set(colorspace=>'YCbCr');
 		#}
-		$err = $magick->Read($fname);
+		$err = $magick->Read($physical_fname);
 	}
 	
 	if ($err) {
-		$r->log->warn("$fname: $err");
+		$r->log->warn("$physical_fname: $err");
 		$err =~ /(\d+)/;
 		if ($1 >= 400) {
 			undef $magick;
-			error($r, "$fname: $err");
+			error($r, "$physical_fname: $err");
 		}
 	}
 
 	# If we use ->[0] unconditionally, text rendering (!) seems to crash
-	my $img = (scalar @$magick > 1) ? $magick->[0] : $magick;
+	my $img;
+	if (ref($magick)) {
+		$img = $magick;
+	} else {
+		$img = (scalar @$magick > 1) ? $magick->[0] : $magick;
+	}
 
 	my $width = $img->Get('columns');
 	my $height = $img->Get('rows');
@@ -556,7 +577,7 @@ sub ensure_cached {
 			# This is slow, but should fortunately almost never happen, so don't bother
 			# special-casing it.
 			if (!defined($dbwidth) || !defined($dbheight)) {
-				$img = read_original_image($r, $id, $dbwidth, $dbheight);
+				$img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, 0);
 				$width = $img->Get('columns');
 				$height = $img->Get('rows');
 				@$img = ();
@@ -574,7 +595,14 @@ sub ensure_cached {
 			$img->Read('xc:white');
 				
 			my $info = Image::ExifTool::ImageInfo($fname);
-			if (!make_infobox($img, $info, $r)) {
+			if (make_infobox($img, $info, $r)) {
+				$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");
@@ -584,13 +612,18 @@ sub ensure_cached {
 				$height = 1;
 			}
 				
-			$err = $img->write(filename => $cachename);
+			$err = $img->write(filename => $cachename, quality => 90, depth => 8);
 			$r->log->info("New infobox cache: $width x $height for $id.jpg");
 			
 			return ($cachename, 'image/png');
 		}
-	
-		my $img = make_mipmap($r, $fname, $id, $dbwidth, $dbheight, $xres, $yres, @otherres);
+
+		my $can_use_qscale = 0;
+		if ($infobox eq 'nobox') {
+			$can_use_qscale = 1;
+		}
+
+		my $img = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale, $xres, $yres, @otherres);
 
 		while (defined($xres) && defined($yres)) {
 			my ($nxres, $nyres) = (shift @otherres, shift @otherres);
@@ -621,7 +654,7 @@ sub ensure_cached {
 			}
 
 			if ($xres != -1) {
-				$cimg->Resize(width=>$nwidth, height=>$nheight, filter=>$filter);
+				$cimg->Resize(width=>$nwidth, height=>$nheight, filter=>$filter, 'sampling-factor'=>$sf);
 			}
 
 			if (($nwidth >= 800 || $nheight >= 600 || $xres == -1) && $infobox ne 'nobox') {
@@ -699,7 +732,7 @@ sub make_infobox {
 		my ($a, $b) = ($1, $2);
 		my $gcd = gcd($a, $b);
 		push @classic_fields, [ $a/$gcd . "/" . $b/$gcd . "s", $shutter_priority ];
-	} elsif (defined($info->{'ExposureTime'}) && $info->{'ExposureTime'} =~ /^(\d+)$/) {
+	} elsif (defined($info->{'ExposureTime'}) && $info->{'ExposureTime'} =~ /^(\d+(?:\.\d+))$/) {
 		push @classic_fields, [ $1 . "s", $shutter_priority ];
 	}