git.sesse.net Git - pr0n/blob - perl/Sesse/pr0n/QscaleProxy.pm

   1 # An object that looks a bit like an Image::Magick object, but has a lot fewer
   2 # methods, and can use qscale behind-the-scenes instead if possible.
   3
   4 package Sesse::pr0n::QscaleProxy;
   5 use strict;
   6 use warnings;
   7
   8 use Image::Magick;
   9
  10 our $has_qscale;
  11
  12 BEGIN {
  13         $has_qscale = 0;
  14         eval {
  15                 require qscale;
  16                 $has_qscale = 1;
  17         };
  18         if ($@) {
  19                 Apache2::ServerUtil->server->log_error("Could not load the qscale module ($@); continuing with ImageMagick only.");
  20         }
  21 }
  22
  23 sub new {
  24         my $ref = {};
  25
  26         if (!$has_qscale) {
  27                 $ref->{'magick'} = Image::Magick->new;
  28         }
  29
  30         bless $ref;
  31         return $ref;
  32 }
  33
  34 sub DESTROY {
  35         my ($self) = @_;
  36
  37         if (exists($self->{'qscale'})) {
  38                 qscale::qscale_destroy($self->{'qscale'});
  39                 delete $self->{'qscale'};
  40         }
  41 }
  42
  43 sub Clone {
  44         my ($self) = @_;
  45
  46         if (exists($self->{'magick'})) {
  47                 return $self->{'magick'}->Clone();
  48         }
  49
  50         my $clone = Sesse::pr0n::QscaleProxy->new;
  51         $clone->{'qscale'} = qscale::qscale_clone($self->{'qscale'});
  52         return $clone;
  53 }
  54
  55 sub Get {
  56         my ($self, $arg) = @_;
  57
  58         if (exists($self->{'magick'})) {
  59                 return $self->{'magick'}->Get($arg);
  60         }
  61
  62         if ($arg eq 'rows') {
  63                 return $self->{'qscale'}->{'height'};
  64         } elsif ($arg eq 'columns') {
  65                 return $self->{'qscale'}->{'width'};
  66         } else {
  67                 die "Unknown attribute '$arg'";
  68         }
  69 }
  70
  71 sub Read {
  72         my ($self, @args) = @_;
  73
  74         if (exists($self->{'magick'})) {
  75                 return $self->{'magick'}->Read(@args);
  76         }
  77         if (exists($self->{'qscale'})) {
  78                 qscale::qscale_destroy($self->{'qscale'});
  79                 delete $self->{'qscale'};
  80         }
  81
  82         # Small hack
  83         if (scalar @args == 1) {
  84                 @args = ( filename => $args[0] );
  85         }
  86
  87         my %args = @args;
  88         my $qscale;
  89         if (exists($args{'filename'})) {
  90                 $qscale = qscale::qscale_load_jpeg($args{'filename'});
  91         } elsif (exists($args{'file'})) {
  92                 $qscale = qscale::qscale_load_jpeg_from_stdio($args{'file'});
  93         } else {
  94                 die "Missing a file or file name to load JPEG from";
  95         }
  96
  97         if (qscale::qscale_is_invalid($qscale)) {
  98                 return "400 Image loading failed";
  99         }
 100         $self->{'qscale'} = $qscale;
 101         return 0;
 102 }
 103
 104 # Note: sampling-factor is not an ImageMagick parameter; it's qscale specific.
 105 sub Resize {
 106         my ($self, %args) = @_;
 107
 108         if (exists($self->{'magick'})) {
 109                 return $self->{'magick'}->Resize(%args);
 110         }
 111
 112         if (!(exists($args{'width'}) &&
 113               exists($args{'height'}) &&
 114               exists($args{'filter'}) &&
 115               exists($args{'sampling-factor'}))) {
 116                 die "Need arguments width, height, filter and sampling-factor.";
 117         }
 118
 119         my $samp_h0 = 2;
 120         my $samp_v0 = 2;
 121         if (defined($args{'sampling-factor'}) && $args{'sampling-factor'} =~ /^(\d)x(\d)$/) {
 122                 $samp_h0 = $1;
 123                 $samp_v0 = $2;
 124         }
 125
 126         my $samp_h1 = 1;
 127         my $samp_v1 = 1;
 128         my $samp_h2 = 1;
 129         my $samp_v2 = 1;
 130
 131         my $filter;
 132         if ($args{'filter'} eq 'Lanczos' ||
 133             $args{'filter'} eq 'Mitchell') {
 134                 $filter = $qscale::LANCZOS;
 135         } else {
 136                 die "Unknown filter " . $args{'filter'};
 137         }
 138
 139         my $nqscale = qscale::qscale_scale($self->{'qscale'}, $args{'width'}, $args{'height'}, $samp_h0, $samp_v0, $samp_h1, $samp_v1, $samp_h2, $samp_v2, $filter);
 140         qscale::qscale_destroy($self->{'qscale'});
 141         $self->{'qscale'} = $nqscale;
 142
 143         return 0;
 144 }
 145
 146 sub Strip {
 147         my ($self) = @_;
 148
 149         if (exists($self->{'magick'})) {
 150                 $self->{'magick'}->Strip();
 151         }
 152 }
 153
 154 sub write {
 155         my ($self, %args) = @_;
 156
 157         if (exists($self->{'magick'})) {
 158                 return $self->{'magick'}->write(%args);
 159         }
 160
 161         my $filename = $args{'filename'};
 162         my $quality = $args{'quality'};
 163
 164         my $jpeg_mode;
 165         if (!defined($args{'interlace'})) {
 166                 $jpeg_mode = $qscale::SEQUENTIAL;
 167         } elsif ($args{'interlace'} eq 'Plane') {
 168                 $jpeg_mode = $qscale::PROGRESSIVE;
 169         } else {
 170                 die "Unknown interlacing mode " . $args{'interlace'};
 171         }
 172
 173         my $ret = qscale::qscale_save_jpeg($self->{'qscale'}, $filename, $quality, $jpeg_mode);
 174         if ($ret == 0) {
 175                 return 0;
 176         } else {
 177                 return "400 Image saving to $filename failed";
 178         }
 179 }
 180
 181 1;
 182