X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=00fa9e9b0c42213676fc70707955ba8a9a696988;hp=3cb605c1a0d6b1c08d8e1c77588fdad58a8c4941;hb=4c67de43660ea5ee7077ab8c2c6b787471901a71;hpb=5f8b3bab0449463c7e33447c5c1c8ea134f84dc3 diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index 3cb605c..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.65"; + $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, $filename, $id, $dbwidth, $dbheight); + $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale); $width = $img->Get('columns'); $height = $img->Get('rows'); } else { @@ -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, $filename, $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,31 +465,39 @@ 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, $filename, $id, $dbwidth, $dbheight); + $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale); } return $img; } sub read_original_image { - my ($r, $filename, $id, $dbwidth, $dbheight) = @_; + my ($r, $filename, $id, $dbwidth, $dbheight, $can_use_qscale) = @_; 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. - $r->log->warn("$physical_fname - $filename"); - if ($filename =~ /\.nef$/i) { + if ($filename =~ /\.(nef|cr2)$/i) { # this would suffice if ImageMagick gets to fix their handling # $physical_fname = "NEF:$physical_fname"; @@ -513,7 +528,12 @@ sub read_original_image { } # 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'); @@ -557,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, $filename, $id, $dbwidth, $dbheight); + $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, 0); $width = $img->Get('columns'); $height = $img->Get('rows'); @$img = (); @@ -597,8 +617,13 @@ sub ensure_cached { return ($cachename, 'image/png'); } - - my $img = make_mipmap($r, $filename, $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); @@ -629,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') { @@ -707,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 ]; }