From 8ccd04f16bde7455ef0bfdb67586b29d33b4cb2e Mon Sep 17 00:00:00 2001 From: "Steinar H. Gunderson" Date: Sat, 12 Jul 2008 23:50:07 +0200 Subject: [PATCH] Add support for scaling using qscale instead of ImageMagick in the situations where all we need is scaling (ie. nobox and mipmap scaling). --- perl/Sesse/pr0n/Common.pm | 50 ++++++--- perl/Sesse/pr0n/QscaleProxy.pm | 182 +++++++++++++++++++++++++++++++++ 2 files changed, 216 insertions(+), 16 deletions(-) create mode 100644 perl/Sesse/pr0n/QscaleProxy.pm diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index a1edaf1..95faead 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 @@ -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,13 @@ 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; + $img = Sesse::pr0n::QscaleProxy->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 +448,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,24 +461,29 @@ sub make_mipmap { } if ($last && !defined($img)) { # OK, read in the smallest one - $img = Image::Magick->new; + $img = Sesse::pr0n::QscaleProxy->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. @@ -512,7 +520,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'); @@ -556,7 +569,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 = (); @@ -596,8 +609,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); @@ -628,7 +646,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') { diff --git a/perl/Sesse/pr0n/QscaleProxy.pm b/perl/Sesse/pr0n/QscaleProxy.pm new file mode 100644 index 0000000..f534d78 --- /dev/null +++ b/perl/Sesse/pr0n/QscaleProxy.pm @@ -0,0 +1,182 @@ +# An object that looks a bit like an Image::Magick object, but has a lot fewer +# methods, and can use qscale behind-the-scenes instead if possible. + +package Sesse::pr0n::QscaleProxy; +use strict; +use warnings; + +use Image::Magick; + +our $has_qscale; + +BEGIN { + $has_qscale = 0; + eval { + require qscale; + $has_qscale = 1; + }; + if ($@) { + Apache2::ServerUtil->server->log_error("Could not load the qscale module ($@); continuing with ImageMagick only."); + } +} + +sub new { + my $ref = {}; + + if (!$has_qscale) { + $ref->{'magick'} = Image::Magick->new; + } + + bless $ref; + return $ref; +} + +sub DESTROY { + my ($self) = @_; + + if (exists($self->{'qscale'})) { + qscale::qscale_destroy($self->{'qscale'}); + delete $self->{'qscale'}; + } +} + +sub Clone { + my ($self) = @_; + + if (exists($self->{'magick'})) { + return $self->{'magick'}->Clone(); + } + + my $clone = Sesse::pr0n::QscaleProxy->new; + $clone->{'qscale'} = qscale::qscale_clone($self->{'qscale'}); + return $clone; +} + +sub Get { + my ($self, $arg) = @_; + + if (exists($self->{'magick'})) { + return $self->{'magick'}->Get($arg); + } + + if ($arg eq 'rows') { + return $self->{'qscale'}->{'height'}; + } elsif ($arg eq 'columns') { + return $self->{'qscale'}->{'width'}; + } else { + die "Unknown attribute '$arg'"; + } +} + +sub Read { + my ($self, @args) = @_; + + if (exists($self->{'magick'})) { + return $self->{'magick'}->Read(@args); + } + if (exists($self->{'qscale'})) { + qscale::qscale_destroy($self->{'qscale'}); + delete $self->{'qscale'}; + } + + # Small hack + if (scalar @args == 1) { + @args = ( filename => $args[0] ); + } + + my %args = @args; + my $qscale; + if (exists($args{'filename'})) { + $qscale = qscale::qscale_load_jpeg($args{'filename'}); + } elsif (exists($args{'file'})) { + $qscale = qscale::qscale_load_jpeg_from_stdio($args{'file'}); + } else { + die "Missing a file or file name to load JPEG from"; + } + + if (qscale::qscale_is_invalid($qscale)) { + return "400 Image loading failed"; + } + $self->{'qscale'} = $qscale; + return 0; +} + +# Note: sampling-factor is not an ImageMagick parameter; it's qscale specific. +sub Resize { + my ($self, %args) = @_; + + if (exists($self->{'magick'})) { + return $self->{'magick'}->Resize(%args); + } + + if (!(exists($args{'width'}) && + exists($args{'height'}) && + exists($args{'filter'}) && + exists($args{'sampling-factor'}))) { + die "Need arguments width, height, filter and sampling-factor."; + } + + my $samp_h0 = 2; + my $samp_v0 = 2; + if (defined($args{'sampling-factor'}) && $args{'sampling-factor'} =~ /^(\d)x(\d)$/) { + $samp_h0 = $1; + $samp_v0 = $2; + } + + my $samp_h1 = 1; + my $samp_v1 = 1; + my $samp_h2 = 1; + my $samp_v2 = 1; + + my $filter; + if ($args{'filter'} eq 'Lanczos' || + $args{'filter'} eq 'Mitchell') { + $filter = $qscale::LANCZOS; + } else { + die "Unknown filter " . $args{'filter'}; + } + + my $nqscale = qscale::qscale_scale($self->{'qscale'}, $args{'width'}, $args{'height'}, $samp_h0, $samp_v0, $samp_h1, $samp_v1, $samp_h2, $samp_v2, $filter); + qscale::qscale_destroy($self->{'qscale'}); + $self->{'qscale'} = $nqscale; + + return 0; +} + +sub Strip { + my ($self) = @_; + + if (exists($self->{'magick'})) { + $self->{'magick'}->Strip(); + } +} + +sub write { + my ($self, %args) = @_; + + if (exists($self->{'magick'})) { + return $self->{'magick'}->write(%args); + } + + my $filename = $args{'filename'}; + my $quality = $args{'quality'}; + + my $jpeg_mode; + if (!defined($args{'interlace'})) { + $jpeg_mode = $qscale::SEQUENTIAL; + } elsif ($args{'interlace'} eq 'Plane') { + $jpeg_mode = $qscale::PROGRESSIVE; + } else { + die "Unknown interlacing mode " . $args{'interlace'}; + } + + my $ret = qscale::qscale_save_jpeg($self->{'qscale'}, $filename, $quality, $jpeg_mode); + if ($ret == 0) { + return 0; + } else { + return "400 Image saving to $filename failed"; + } +} + +1; + -- 2.39.2