package Image::Imager::Thumbnail;
use strict;
use warnings;
our $VERSION = '0.01';
=head1 NAME
Image::Imager::Thumbnail - Produces thumbnail images with Imager
=head1 SYNOPSIS
use Image::Imager::Thumbnail;
my $tb = new Image::Imager::Thumbnail (
file_src => $src,
file_dst => $dst,
width => $w,
height => $h
);
$tb->save;
__END__
=head1 DESCRIPTION
This module uses the Imager library to create a thumbnail image with no side bigger than you specify.
=cut
=head1 PREREQUISITES
Imager
=cut
use Imager;
my %fields =
(
file_src => '',
file_dst => '',
height => 0,
width => 0,
);
sub new {
my ($proto,%options) = @_;
my $class = ref($proto) || $proto;
my $self = {%fields};
bless $self, $class;
while (my ($key,$value) = each(%options)) {
if (exists($fields{$key})) {
$self->{$key} = $value;
} else {
die __PACKAGE__ . "::new: invalid option '$key'\n";
}
}
return $self;
}
sub save {
my $self = shift;
my $type = shift || 'jpeg';
my $ret;
my $height_d = $self->{height};
my $width_d = $self->{width};
my $srcImage = Imager->new();
unless ($srcImage->open(file=>$self->{file_src})) {
my $errImage = Imager->new(xsize=>600, ysize=>15,
channels=>3, bits=>16);
#$white = $errImage->colorAllocate(255,255,0);
my $red = Imager::Color->new( 255, 0, 0 );
#$red = $errImage->colorAllocate(255,0,0);
#$errImage->string(gdSmallFont,0,0,"Unable to find " . $self->{file},$red);
$errImage->string(text=>"Ciao", x=>0,y=>0,size=>10,color=>$red);
$errImage->write(data => \$ret, type => $type) or die $errImage->errstr;
return $ret;
}
my ($width_s,$height_s) = ($srcImage->getwidth,$srcImage->getheight);
if ($height_d == 0) {
my $ratio = $width_d/$width_s;
$height_d = $height_s * $ratio;
} elsif ($width_d == 0) {
my $ratio = $height_d/$height_s;
$width_d = $width_s * $ratio;
}
my $dstImage = $srcImage->scaleX(pixels=>$width_d)->scaleY(pixels=>$height_d);
my %opts;
if ($type eq 'gif') {
$opts{interlace} = 1;
}
$dstImage->write(file => $self->{file_dst}, type => $type,%opts) or die $dstImage->errstr;
# salvo in cache;
}
sub width {
my $self = shift;
return @_ ? $self->{width} = shift : $self->{width};
}
sub height {
my $self = shift;
return @_ ? $self->{height} = shift : $self->{height};
}
sub file_src {
my $self = shift;
return @_ ? $self->{file_src} = shift : $self->{file_src};
}
sub file_dst {
my $self = shift;
return @_ ? $self->{file_dst} = shift : $self->{file_dst};
}
1;