Commits

Burak Gürsoy  committed 9af4d32

Perl::Critic refactoring

  • Participants
  • Parent commits 9720c2e

Comments (0)

Files changed (6)

 use strict;
+use warnings;
 use lib qw( builder );
 use Build;
 
 my $mb = Build->new;
 $mb->change_versions(1);
-$mb->copyright_first_year( 2006 );
+$mb->copyright_first_year( '2006' );
 $mb->add_pod_author_copyright_license(1);
 $mb->create_build_script;
+
+1;
 
 Time zone is GMT+2.
 
+1.40 Fri Sep 25 19:48:53 2009
+    => Perl::Critic refactoring.
+
 1.35 Fri Sep  4 00:29:03 2009
     => Fix for RT#49353. Thanks to Alexander Vonk.
     => Removed the bytes pragma trick for legacy perls. If you still need it,
 Copyright (c) 2006-2009 Burak Gürsoy <burak@cpan.org>. All rights reserved.
 
 This library is free software; you can redistribute it and/or modify 
-it under the same terms as Perl itself, either Perl version 5.8.8 or, 
+it under the same terms as Perl itself, either Perl version 5.10.1 or, 
 at your option, any later version of Perl 5 you may have available.
 {
-    module_name    => 'GD::Thumbnail',
-    requires       => {
+    module_name => 'GD::Thumbnail',
+    requires    => {
         'GD' => 0,
+        ( $] < 5.006 ? ( 'warnings::compat'  => 0 ) : () ),
     },
     meta_merge => {
         resources => {
             repository => 'http://bitbucket.org/burak/cpan-gd-thumbnail/',
         },
     },
-}
+}

File lib/GD/Thumbnail.pm

 package GD::Thumbnail;
 use strict;
+use warnings;
 use vars qw($VERSION %TMP);
 
-$VERSION = '1.35'; # GD version check below breaks ExtUtils::MM
+$VERSION = '1.40';
 
 use GD;
 use Carp qw( croak );
 
-use constant GIF_OK       => $GD::VERSION >= 2.15 || $GD::VERSION <= 1.19;
-use constant DEFAULT_MIME => 'png';
-use constant BUFFER       => 2; # y-buffer for info strips in pixels
-use constant BLACK        => [  0,   0,   0];
-use constant WHITE        => [255, 255, 255];
-use constant IMG_X        => 0;
-use constant IMG_Y        => 1;
-use constant ALL_MIME     => qw(gif png jpeg gd gd2 wbmp);
+use constant GIF_OK               => $GD::VERSION >= 2.15 || $GD::VERSION <= 1.19;
+use constant DEFAULT_MIME         => 'png';
+use constant BUFFER               => 2; # y-buffer for info strips in pixels
+use constant BLACK                => [   0,   0,   0 ];
+use constant WHITE                => [ 255, 255, 255 ];
+use constant IMG_X                => 0;
+use constant IMG_Y                => 1;
+use constant ALL_MIME             => qw(gif png jpeg gd gd2 wbmp);
+
+use constant KILOBYTE             => 1024;
+use constant MEGABYTE             => 1024 * KILOBYTE;
+use constant GIGABYTE             => 1024 * MEGABYTE;
+
+use constant DEFAULT_MAX_PIXELS   =>   50;
+use constant PATH_LENGTH          =>  255;
+use constant MAX_JPEG_QUALITY     =>  100;
+use constant MAX_PNG_COMPRESSION  =>    9;
+use constant STAT_SIZE            =>    7;
+use constant RATIO_CONSTANT       =>  100;
+use constant RE_FILE_EXTENSION    => qr{ [.] (png|gif|jpg|jpe|jpeg) \z }xmsi;
+use constant RE_RATIO             => qr{ (\d+)(?:\s+|)% }xms;
 
 %TMP = ( # global template. so that one can change the text
    GB   => '%.2f GB',
    TEXT => '<WIDTH>x<HEIGHT> <MIME>',
 );
 
-my %KNOWN = map {$_, $_} ALL_MIME;
+my %KNOWN = map { ($_, $_) } ALL_MIME;
    $KNOWN{'jpg'} = 'jpeg';
    $KNOWN{'jpe'} = 'jpeg';
 
-my %IS_GD_FONT = map {lc($_), $_ } qw(Small Large MediumBold Tiny Giant);
-my %SIZE; # see _size()
+my %IS_GD_FONT = map { ( lc($_), $_ ) } qw(Small Large MediumBold Tiny Giant);
 
 GD::Image->trueColor(1) if GD::Image->can('trueColor');
 
 sub new {
-   my $class = shift;
-   my %o     = scalar(@_) % 2 ? () : (@_);
-   my $self  = {
-      DIMENSION   => [0, 0], # Thumbnail dimension
+   my($class, @args)= @_;
+   my %o    = @args % 2 ? () : @args;
+   my $self = {
+      DIMENSION   => [ 0, 0 ], # Thumbnail dimension
       GD_FONT     => 'Tiny', # info text color
       OVERLAY     => 0,      # bool: overlay info strips?
       STRIP_COLOR => BLACK,
       SQUARE      => 0,      # bool: make square thumb?
       FRAME_COLOR => BLACK,
       FRAME       => 0,      # bool: add frame?
-      FORCE_MIME  => '',     # force output type?
-      MIME        => '',
+      FORCE_MIME  => q{},     # force output type?
+      MIME        => q{},
    };
    $self->{FRAME}      = $o{frame}  ? 1          : 0;
    $self->{SQUARE}     = $o{square} ? $o{square} : 0;
    $self->{OVERLAY}    = ($o{overlay}   || $self->{SQUARE}) ? 1 : 0;
-   $self->{FORCE_MIME} = $o{force_mime} || '';
-   if ($o{font} and my $font = $IS_GD_FONT{ lc( $o{font} ) }) {
+   $self->{FORCE_MIME} = $o{force_mime} || q{};
+   if ( $o{font} and my $font = $IS_GD_FONT{ lc $o{font} } ) {
       $self->{GD_FONT} = $font;
    }
-   my $color;
    for my $id (qw[STRIP_COLOR INFO_COLOR FRAME_COLOR]) {
       if (my $color = $o{ lc $id }) {
-         if(ref $color && ref $color eq 'ARRAY' && $#{$color} == 2) {
+         if ( ref $color && ref $color eq 'ARRAY' && $#{$color} == 2 ) {
             $self->{$id} = $color;
          }
       }
    return $self;
 }
 
-sub create {
-   my $self  = shift;
-   my $image = shift || die "image parameter is missing!";
-   my $max   = shift || 50;
-   my $info  = shift ||  0;
-   my $info2 = $info && $info == 2;
+sub _check_type {
+   my($self, $image) = @_;
    my $type;
-
-   if(length($image) <= 300 && $image =~ m{\.(png|gif|jpg|jpe|jpeg)}i) {
+   if ( length $image <= PATH_LENGTH && $image =~ RE_FILE_EXTENSION ) {
       $type = $KNOWN{lc $1};
-      if($type eq 'gif' && !GIF_OK) {
+      if ( $type eq 'gif' && !GIF_OK ) {
          # code will probably die at $gd assignment below
-         warn "GIF format is not supported by this version ($GD::VERSION) of GD";
+         warn "GIF format is not supported by this version ($GD::VERSION) of GD\n";
          $type = DEFAULT_MIME;
       }
    }
 
-   $type         = DEFAULT_MIME unless $type;
+   $type = DEFAULT_MIME if ! $type;
+   return $type;
+}
+
+sub _check_ratio {
+   my($self, $max, $w) = @_;
+   my $ratio;
+   if ( $max =~ RE_RATIO ) {
+      $ratio = $1;
+   }
+   else {
+      $ratio = sprintf '%.1f', $max * RATIO_CONSTANT / $w;
+   }
+   croak 'Can not determine thumbnail ratio' if ! $ratio;
+   return $ratio;
+}
+
+sub _get_iy {
+   my($self, $info, $info2, $o, $y, $yy) = @_;
+   return 0 if ! $info;
+   return $o       ? $y - $yy
+          : $info2 ? $y + $yy + BUFFER/2
+          :          $y       + BUFFER/2
+          ;
+}
+
+sub _strips {
+   my($self, $info, $info2, $o, $x, $y, $yy) = @_;
+   my $iy = $self->_get_iy( $info, $info2, $o, $y, $yy );
+   my @strips;
+   push @strips, [ $info , 0, $iy, 0, 0, $x, $y , RATIO_CONSTANT ] if $info;
+   push @strips, [ $info2, 0,   0, 0, 0, $x, $yy, RATIO_CONSTANT ] if $info2;
+   return @strips;
+}
+
+sub _alter_for_crop {
+   my($self, $xsmall, $x_ref, $y_ref, $dx_ref, $dy_ref) = @_;
+   if ( $xsmall ) {
+      my $diff   = (${$y_ref} - ${$x_ref}) / ${$x_ref};
+      ${$x_ref} += ${$x_ref} * $diff;
+      ${$y_ref} += ${$y_ref} * $diff;
+      ${$dy_ref} = -${$dx_ref} * (2 - ${$x_ref} / ${$y_ref})**2;
+      ${$dx_ref} = 0;
+   }
+   else {
+      my $diff   = (${$x_ref} - ${$y_ref}) / ${$y_ref};
+      ${$x_ref} += ${$x_ref} * $diff;
+      ${$y_ref} += ${$y_ref} * $diff;
+      ${$dx_ref} = -${$dy_ref} * ( 2 - ${$y_ref}/${$x_ref} )**2;
+      ${$dy_ref} = 0;
+   }
+   return;
+}
+
+sub _setup_parameters {
+   my($self, $opt, $x_ref, $y_ref, $dx_ref, $dy_ref, $ty_ref ) = @_;
+   if ( $opt->{square} ) {
+      my $rx = $opt->{width} < $opt->{height} ? $opt->{width}/$opt->{height} : 1;
+      my $ry = $opt->{width} < $opt->{height} ? 1 : $opt->{height}/$opt->{width};
+      my $d;
+      if ( $opt->{xsmall} ) {
+         $d         =  ${$x_ref} * $rx;
+         ${$dx_ref} = (${$x_ref} - $d) / 2;
+         ${$x_ref}  = $d;
+      }
+      else {
+         $d         = ${$y_ref} * $ry;
+         ${$dy_ref} = (${$y_ref} - $d) / 2;
+         ${$y_ref}  = $d;
+      }
+   }
+
+   if ( ! $opt->{square} || ( $opt->{square} && $opt->{xsmall} ) ) {
+      # does not work if square & y_is_small, 
+      # since we may have info bars which eat y space
+      ${$ty_ref} = 0; # TODO. test this more and remove from below
+      ${$y_ref}  = ${$y_ref} - ${$ty_ref} - BUFFER/2 if $opt->{overlay};
+   }
+   return;
+}
+
+sub create {
+   my $self      = shift;
+   my $image     = shift || croak 'Image parameter is missing';
+   my $max       = shift || DEFAULT_MAX_PIXELS;
+   my $info      = shift || 0;
+
+   my $info2     = $info && $info == 2;
+   my $type      = $self->_check_type( $image );
    my $o         = $self->{OVERLAY};
-   my $size      = $info2 ? $self->_image_size($image) : 0;
-   my $gd        = GD::Image->new($image) or die "GD::Image->new error: $!";
-   my($w, $h)    = $gd->getBounds         or die "getBounds() failed: $!";
-   my $ratio     = $max =~ m{(\d+)(?:\s+|)%} ? $1
-                 :                             sprintf('%.1f', $max * 100 / $w)
-                 ;
+   my $size      = $info2 ? $self->_image_size( $image ) : 0;
+   my $gd        = GD::Image->new($image) or croak "GD::Image->new error: $!";
+   my($w, $h)    = $gd->getBounds         or croak "getBounds() failed: $!";
+   my $ratio     = $self->_check_ratio($max, $w);
+   my $square    = $self->{SQUARE} || 0;
+   my $crop      = $square && lc $square eq 'crop';
 
-   die "Can not determine thumbnail ratio" if ! $ratio;
-
-   my $square    = $self->{SQUARE} || 0;
-   my $crop      = $square && lc($square) eq 'crop';
-
-   my $x         = sprintf '%.0f', $w * $ratio / 100;
-   my $def_y     = sprintf '%.0f', $h * $ratio / 100;
+   my $x         = sprintf '%.0f', $w * $ratio / RATIO_CONSTANT;
+   my $def_y     = sprintf '%.0f', $h * $ratio / RATIO_CONSTANT;
    my $y         = $square ? $x : $def_y;
    my $yy        = 0; # yy & yy2 has the same value
    my $yy2       = 0;
 
    my $ty        = $yy + $yy2;
    my $new_y     = $o ? $y : $y + $ty;
-   my $thumb     = GD::Image->new($x, $new_y);
+   my $thumb     = GD::Image->new( $x, $new_y );
 
    # RT#49353 | Alexander Vonk: prefill Thumbnail with strip color, as promised
    $thumb->fill( 0, 0, $thumb->colorAllocate( @{ $self->{STRIP_COLOR} } ) );
 
    $thumb->colorAllocate(@{ +WHITE }) if ! $info;
 
-   my $iy = 0;
-   if ($info) {
-      $iy = $o     ? $y - $yy
-          : $info2 ? $y + $yy + BUFFER/2
-          :          $y       + BUFFER/2
-          ;
-   }
-
-   my @strips;
-   push @strips, [$info , 0, $iy, 0, 0, $x, $y , 100] if $info;
-   push @strips, [$info2, 0,   0, 0, 0, $x, $yy, 100] if $info2;
-
+   my @strips = $self->_strips( $info, $info2, $o, $x, $y, $yy );
    my $dx     = 0;
    my $dy     = $yy2 || 0;
    my $xsmall = $x < $def_y;
 
-   if ( $square ) {
-      my $rx = ($w < $h) ? $w/$h :     1;
-      my $ry = ($w < $h) ? 1     : $h/$w;
-      my $d;
-      if($xsmall) { $d = $x * $rx; $dx = ($x - $d) / 2; $x = $d; }
-      else        { $d = $y * $ry; $dy = ($y - $d) / 2; $y = $d; }
-   }
+   $self->_setup_parameters(
+      {
+         xsmall  => $xsmall,
+         square  => $square,
+         width   => $w,
+         height  => $h,
+         overlay => $o,
+      },
+      \$x, \$y, \$dx, \$dy, \$ty
+   );
 
-   if (not $square or $square && $xsmall) {
-      # does not work if square & y_is_small, 
-      # since we may have info bars which eat y space
-      $ty = 0; # TODO. test this more and remove from below
-      $y = $y - $ty - BUFFER/2 if $o;
-   }
-
-   if ( $crop ) {
-      if ( $xsmall ) {
-         my $diff = ($y - $x) / $x;
-         $x += $x * $diff;
-         $y += $y * $diff;
-         $dy = -$dx * (2 - $x / $y)**2;
-         $dx = 0;
-      }
-      else {
-         my $diff = ($x - $y) / $y;
-         $x += $x * $diff;
-         $y += $y * $diff;
-         $dx = -$dy * (2-$y/$x)**2;
-         $dy = 0;
-      }
-   }
+   $self->_alter_for_crop( $xsmall, \$x, \$y, \$dx, \$dy ) if $crop;
 
    my $resize = $thumb->can('copyResampled') ? 'copyResampled' : 'copyResized';
 
    $thumb->$resize($gd, $dx, $dy, 0, 0, $x, $y, $w, $h);
-   $thumb->copyMerge(@{$_}) for @strips;
+   $thumb->copyMerge( @{$_} ) for @strips;
 
+   return $self->_finish( $thumb, $type );
+}
+
+sub _finish {
+   my($self, $thumb, $type) = @_;
    my @dim = $thumb->getBounds;
 
    $self->{DIMENSION}[IMG_X] = $dim[IMG_X];
 
    if ($self->{FRAME}) {
       my $color = $thumb->colorAllocate(@{ $self->{FRAME_COLOR} });
-      $thumb->rectangle(0, 0, $dim[IMG_X]-1, $dim[IMG_Y]-1, $color);
+      $thumb->rectangle( 0, 0, $dim[IMG_X] - 1, $dim[IMG_Y] - 1, $color );
    }
 
    my $mime = $self->_force_mime($thumb);
       $type = $mime if $mime;
    $self->{MIME} = $type;
    my @iopt;
-   push @iopt, 100 if $type eq 'jpeg';
-   push @iopt,   9 if $type eq 'png';
-   return $thumb->$type(@iopt);
+   push @iopt, MAX_JPEG_QUALITY    if $type eq 'jpeg';
+   push @iopt, MAX_PNG_COMPRESSION if $type eq 'png';
+   return $thumb->$type( @iopt );
 }
 
-sub width  { shift->{DIMENSION}[IMG_X] }
-sub height { shift->{DIMENSION}[IMG_Y] }
-sub mime   { shift->{MIME}             }
+sub width  { return shift->{DIMENSION}[IMG_X] }
+sub height { return shift->{DIMENSION}[IMG_Y] }
+sub mime   { return shift->{MIME}             }
 
 sub _force_mime {
    my $self = shift;
    my $gd   = shift || return;
-   return unless $self->{FORCE_MIME};
-   my %mime = map {$_, $_} ALL_MIME;
+   return if ! $self->{FORCE_MIME};
+   my %mime = map { ( $_, $_ ) } ALL_MIME;
    my $type = $mime{ lc $self->{FORCE_MIME} } || return;
    return unless $gd->can($type);
    return $type;
 }
 
 sub _text {
-   my $self = shift;
-   my($w, $h, $type) = @_;
+   my($self, $w, $h, $type) = @_;
    $type = uc $type;
-   my $tmp = $TMP{TEXT} || die "TEXT template is not set";
+   my $tmp = $TMP{TEXT} || croak 'TEXT template is not set';
    $tmp =~ s{<WIDTH>}{$w}xmsg;
    $tmp =~ s{<HEIGHT>}{$h}xmsg;
    $tmp =~ s{<MIME>}{$type}xmsg;
    my $image    = shift;
    my $img_size = 0;
    # don't do that at home. very dangerous :p
-   if(defined &GD::Image::_image_type && GD::Image::_image_type($image)) {
-      $img_size = length($image);
-   } elsif (defined(fileno $image)) {
-      local $/;
+   if ( GD::Image->can('_image_type') && GD::Image::_image_type($image) ) {
+      use bytes;
+      $img_size = length $image;
+   }
+   elsif ( defined fileno $image ) {
       binmode $image;
       use bytes;
+      local $/;
       $img_size = length <$image>;
-   } else {
+   }
+   else {
       if(-e $image && !-d _) {
-         $img_size = (stat $image)[7];
+         $img_size = (stat $image)[STAT_SIZE];
       }
    }
    return $img_size;
    my $x      = shift;
    my $type   = $self->{GD_FONT};
    my $font   = GD::Font->$type();
-   my $sw     = $font->width * length($string);
+   my $sw     = $font->width * length $string;
    my $sh     = $font->height;
-   warn "Thumbnail width ($x) is too small for an info text" if $x < $sw;
+   warn "Thumbnail width ($x) is too small for an info text\n" if $x < $sw;
    my $info   = GD::Image->new($x, $sh+BUFFER);
    my $color = $info->colorAllocate(@{ $self->{STRIP_COLOR} });
    $info->filledRectangle(0,0,$x,$sh+BUFFER,$color);
 
 sub _size {
    my $self = shift;
-   my $size = shift || return "0 byte";
-   unless (%SIZE) {
-      eval q~
-         %SIZE = (
-            GB => 1024 * 1024 * 1024,
-            MB => 1024 * 1024,
-            KB => 1024,
-         );
-      ~;
-   }
-   return sprintf($TMP{GB}, $size / $SIZE{GB}) if($size >= $SIZE{GB});
-   return sprintf($TMP{MB}, $size / $SIZE{MB}) if($size >= $SIZE{MB});
-   return sprintf($TMP{KB}, $size / $SIZE{KB}) if($size >= $SIZE{KB});
-   return sprintf($TMP{BY}, $size);
+   my $size = shift || return '0 bytes';
+   return sprintf $TMP{GB}, $size / GIGABYTE if $size >= GIGABYTE;
+   return sprintf $TMP{MB}, $size / MEGABYTE if $size >= MEGABYTE;
+   return sprintf $TMP{KB}, $size / KILOBYTE if $size >= KILOBYTE;
+   return sprintf $TMP{BY}, $size;
 }
 
 1;
 
 __END__
 
+=pod
+
 =head1 NAME
 
 GD::Thumbnail - Thumbnail maker for GD

File t/003-simple.t

 #!/usr/bin/env perl -w
 use strict;
-use Test;
+use warnings;
+use Test::More;
 use GD::Thumbnail;
 use File::Spec;
+use IO::File;
 use Cwd;
+use Carp qw( croak );
 use IO::File;
 
+use constant RGB_WHITE  => 255, 255, 255;
+use constant RGB_BLACK  =>   0,   0,   0;
+use constant MAX_PIXELS => 100;
+
 sub save;
 
 BEGIN {
 
 my $COUNTER = 1;
 
-my $foriginal   = File::Spec->catfile(getcwd, 'cpan.jpg');
-my $foriginal90 = File::Spec->catfile(getcwd, 'cpan90.jpg');
+my $foriginal   = File::Spec->catfile( getcwd, 'cpan.jpg'   );
+my $foriginal90 = File::Spec->catfile( getcwd, 'cpan90.jpg' );
 
-ok(-e $foriginal   && ! -d _);
-ok(-e $foriginal90 && ! -d _);
+ok( ( -e $foriginal   && ! -d _ ), 'Original file seems to be ok'         );
+ok( ( -e $foriginal90 && ! -d _ ), 'Original rotated file seems to be ok' );
 
 my($original, $original90);
 
    my $o   = IO::File->new;
    my $o90 = IO::File->new;
 
-   $o->open("$foriginal")     or die "Can not open $foriginal   : $!";
-   $o90->open("$foriginal90") or die "Can not open $foriginal90 : $!";
+   $o->open(   $foriginal   ) or croak "Can not open $foriginal   : $!";
+   $o90->open( $foriginal90 ) or croak "Can not open $foriginal90 : $!";
    binmode $o;
    binmode $o90;
 
 }
 
 my %opt = (
-   strip_color => [255, 255, 255],
-   info_color  => [  0,   0,   0],
+   strip_color => [ RGB_WHITE ],
+   info_color  => [ RGB_BLACK ],
    square      => 1,
    frame       => 1,
 );
 delete @opt{qw/ strip_color info_color /};
 run();
 
-$opt{square}  = "crop";
+$opt{square}  = 'crop';
 run();
 
 sub run { # x42 tests
-   test(GD::Thumbnail->new(%opt), $original  );
-   test(GD::Thumbnail->new(%opt), $original90);
+   test( GD::Thumbnail->new(%opt), $original   );
+   test( GD::Thumbnail->new(%opt), $original90 );
 
-   test($_, $original) for
-      GD::Thumbnail->new(%opt, force_mime  => 'gif' ),
-      GD::Thumbnail->new(%opt, force_mime  => 'png' ),
-      GD::Thumbnail->new(%opt, force_mime  => 'jpeg'),
-      GD::Thumbnail->new(%opt, force_mime  => 'gd'  ),
-      GD::Thumbnail->new(%opt, force_mime  => 'gd2' ),
+   test( $_, $original ) for
+      GD::Thumbnail->new( %opt, force_mime  => 'gif'  ),
+      GD::Thumbnail->new( %opt, force_mime  => 'png'  ),
+      GD::Thumbnail->new( %opt, force_mime  => 'jpeg' ),
+      GD::Thumbnail->new( %opt, force_mime  => 'gd'   ),
+      GD::Thumbnail->new( %opt, force_mime  => 'gd2'  ),
    ;
+   return;
 }
 
 sub test { # x6 tests
    my $gd  = shift;
    my $img = shift;
    #seek $img, 0, 0;
-   ok( save $gd->create($img, 100, 2), $gd->mime );
-   ok( save $gd->create($img, 100, 1), $gd->mime );
-   ok( save $gd->create($img, 100, 0), $gd->mime );
-   $gd->{FRAME}  = 0;
-   $gd->{SQUARE} = 0;
-   $gd->{OVERLAY}= 0;
-   ok( save $gd->create($img, 100, 2), $gd->mime );
-   ok( save $gd->create($img, 100, 1), $gd->mime );
-   ok( save $gd->create($img, 100, 0), $gd->mime );
+   ok( save $gd->create($img, MAX_PIXELS, 2), $gd->mime );
+   ok( save $gd->create($img, MAX_PIXELS, 1), $gd->mime );
+   ok( save $gd->create($img, MAX_PIXELS, 0), $gd->mime );
+   $gd->{FRAME}   = 0;
+   $gd->{SQUARE}  = 0;
+   $gd->{OVERLAY} = 0;
+   ok( save $gd->create($img, MAX_PIXELS, 2), $gd->mime );
+   ok( save $gd->create($img, MAX_PIXELS, 1), $gd->mime );
+   ok( save $gd->create($img, MAX_PIXELS, 0), $gd->mime );
+   return;
 }
 
 sub save {
    my($raw, $mime) = @_;
    my $id = sprintf '%04d.%s', $COUNTER++, $mime;
-   local  *IMG;
-   open    IMG, '>'.$id or die "save error: $!";
-   binmode IMG;
-   print   IMG $raw;
-   close   IMG;
+   my $IMG = IO::File->new;
+   $IMG->open( $id, '>' ) or croak "Save error: $!";
+   binmode $IMG;
+   my $pok = print {$IMG} $raw;
+   $IMG->close;
    return  1;
 }