The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Image::Magick::Thumbnail::Fixed;

use 5.6.1;
use strict;
use warnings;
use Carp;

require Image::Magick;

our $VERSION = '0.04';

sub new {
  my $class = shift;  
  my $self = bless {}, $class;
}

sub debug {
  my $self = shift;
  $self->{debug} = shift;
}
 
sub thumbnail {
  my ($self, %args) = @_;
  
  my $im = new Image::Magick;
  
  # Required Parameters
  my $input   = $args{input};
  my $output  = $args{output};
  my $width   = $args{width};
  my $height  = $args{height};

  if( !$input ){
    carp "No input path specified";
    return undef;
  }
  
  if( !$output ){
    carp "No output path specified";
    return undef;
  }
  
  if( !$width ){
    carp "No width specified";
    return undef;
  }
  elsif( $width <= 0 ){
    carp "Invalid width";
    return undef;
  }
  
  if( !$height ){
    carp "No height specified";
    return undef;
  }elsif( $height <= 0 ){
    carp "Invalid height";
    return undef;
  }
  
  # Optional Parameters (passed to ImageMagick -- no local error checking)
  my $density = $args{density} || $width . "x" . $height;
  my $quality = $args{quality} || '70';
  my $bgcolor = $args{bgcolor} || 'white';
  my $format  = $args{format}  || 'jpg';
  my $compose = $args{compose} || 'over';
  my $gravity = $args{gravity} || 'center';
  

  if( $self->{debug} ){
    warn "Input   : $input\n";
    warn "Output  : $output\n";
    warn "ThumbWH : $width x $height\n";
    warn "Density : $density\n";
    warn "Quality : $quality\n";
    warn "BgColor : $bgcolor\n";
    warn "Format  : $format\n";
  }
  
  eval {

  	open(IMAGE,"<$input") or carp "Could not open $input: $!" and return undef;
  	my $err = $im->Read(file=>\*IMAGE);
  	die $err if $err;
	  close(IMAGE);

    # source image dimensions  
    my ($o_width, $o_height) = $im->Get('width','height');
  
  	warn "Source  : $o_width x $o_height\n" if $self->{debug};
   
    warn "Source image height <= 0 ($o_height)." and return undef if $o_height <= 0;
    warn "Source image width <= 0 ($o_width)." and return undef if $o_width  <= 0;
    
    # calculate image dimensions required to fit onto thumbnail
    my ($t_width, $t_height, $ratio);
    # wider than tall (seems to work...) needs testing
    if( $o_width > $o_height ){
      $ratio = $o_width / $o_height;
      $t_width = $width;    
      $t_height = $width / $ratio;
  
      # still won't fit, find the smallest size.
      while($t_height > $height){
        $t_height -= $ratio;
        $t_width -= 1;
      }
    }
    # taller than wide
    elsif( $o_height > $o_width ){
      $ratio = $o_height / $o_width;  
      $t_height = $height;
      $t_width = $height / $ratio;
  
      # still won't fit, find the smallest size.
      while($t_width > $width){
        $t_width -= $ratio;
        $t_height -= 1;
      }
    }
    # square (fixed suggested by Philip Munt phil@savvyshopper.net.au)
    elsif( $o_width == $o_height){
      $ratio = 1;
      $t_height = $width;
      $t_width  = $width;
       while (($t_width > $width) or ($t_height > $height)){
         $t_width -= 1;
         $t_height -= 1;
       }
    }

    warn "Ratio   : $ratio\n" if $self->{debug};
    warn "ThumbWH : $t_width x $t_height\n" if $self->{debug};      
  
    # Create thumbnail
    if( defined $im ){
      $im->Resize( width => $t_width, height => $t_height );
      $im->Set( quality => $quality );
      $im->Set( density => $density );
      
      my $thumb = new Image::Magick;
    
      $thumb->Set( size => $width . "x" . $height );
      $thumb->Set( quality => $quality );
      $thumb->Set( density => $density ); 
    
      $thumb->Read("gradient:$bgcolor-$bgcolor");
      
      $thumb->Composite( image   => $im, 
                         compose => $compose,
                         gravity => $gravity );
           
      $thumb->Write("$format:$output");
      
    }
  };
  if( $@ ){
    warn $@ and return undef;
  }
  return 1;
}

1;
__END__
# Below is stub documentation for your module. You'd better edit it!
 
=head1 NAME

Image::Magick::Thumbnail::Fixed - Perl extension for creating fixed sized thumbnails without distortion.

=head1 SYNOPSIS

  use Image::Magick::Thumbnail::Fixed;
  my $t = new Image::Magick::Thumbnail::Fixed;
  
  # Required parameters
  $t->thumbnail( input   => 'input.jpg',
                 output  => 'output.jpg',
                 width   => 96,
                 height  => 72 );
   
  # Required and optional parameters
  $t->thumbnail( input   => 'input.jpg',
                 output  => 'output.jpg',
                 width   => 96,
                 height  => 72,
                 density => '96x72',
                 gravity => 'center',
                 compose => 'over',
                 quality => '90',
                 bgcolor => 'white',
                 format  => 'jpg' );

=head1 DESCRIPTION

Create fixed sized thumbnails without distorting or stretching the source image. 

Example: The source image is 349 x 324 (1.077 ratio). The thumbnail image is to be 96x72 (1.333 ratio).
Resizing the source image to 96 x 72 will cause distortion. This module will first resize the source in memory
(to 66 x 71) and then compose it ontop of the thumbnail canvas.

=head1 PREREQUISITES

C<Image::Magick>

=cut


=head2 REQUIRED PARAMETERS

=over 4

=item input

The input path of the source image.

=item output

The output path of the thumbnail image.

=item width

The width of the thumbnail image.

=item height

The height of the thumbnail image.

=back

=head2 OPTIONAL PARAMETERS

See http://imagemagick.org/www/perl.html for information regarding optional parameters (density, gravity, compose, color, quality, format).

=over 4

=item density

Vertical and horizontal resolution in pixels of the image. Takes 
an ImageMagick 'geometry' string (ie: '96x72'). Default: width x height of the thumbnail.

=item gravity

Type of image gravity. Options: {Forget, NorthWest, North, NorthEast, West, Center, East, SouthWest, South, SouthEast}
Default: center

=item compose

Composite operator. Options: {Over, In, Out, Atop, Xor, Plus, Minus, Add, Subtract, Difference, Bumpmap, Copy, Mask, Dissolve, Clear, Displace}
Default: over

=item bgcolor

Background color of the thumbnail canvas (will only show if the ratio of the source does not match the ratio of the thumbnail).
Options: http://imagemagick.org/www/color.html Default: white

=item quality

JPEG/MIFF/PNG compression level (range 0-100). 
Default: 70

=item format

Image format. 
Default: jpg


=head2 EXPORT

None by default.

=head1 VERSION HISTORY

Version 0.01 (18 August 2004): Initial Revision

Version 0.02 (31 August 2004): Perl 5.6.1 support, fixed height/width calculations that were broken in certain situations.

Version 0.03 (25 September 2004): made debug mode more verbose. Caught additional errors.

Version 0.04 (26 April 2005): Fixed debugging conditional that was too loud - pd <paul@dowling.id.au>, fixed bug with square images - Phillip Munt <phil@savvyshopper.net.au>.
 
=head1 SEE ALSO

L<Image::Magick>,
L<Image::Magick::Thumbnail>,
L<Image::Thumbnail>

=head1 AUTHOR

Adam Roth, E<lt>aroth@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Adam Roth, all rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut