Image-Magick-Thumbnail
view release on metacpan or search on metacpan
Revision history for Perl extension Image::Magick::Thumbnail.
0.05 08 February 2008
Allow forcing which side to which scale, for Arthur.
0.05 Wed Dec 19 11:56:00 2007
0.03 Sun Apr 17 12:13:14 2005
Catches a weird floating point situation, spotted by
André Warrier.
0.02 Date?
Caught some operator errors and supported gemortry
0.01 Thu Jun 6 17:17:42 2002
- original version; created by h2xs 1.21 with options
-X -n Image::Magick::Thumbnail
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Image-Magick-Thumbnail
version: 0.06
version_from: lib/Image/Magick/Thumbnail.pm
installdirs: site
requires:
Image::Magick: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Image::Magick::Thumbnail',
'VERSION_FROM' => 'lib/Image/Magick/Thumbnail.pm', # finds $VERSION
'PREREQ_PM' => {Image::Magick=>0,}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Image/Magick/Thumbnail.pm', # retrieve abstract from module
AUTHOR => 'Lee Goddard <cpan-at-leegoddard-dot-net>') : ()),
);
use lib "../lib";
use Image::Magick::Thumbnail;
my $src = new Image::Magick;
$src->Read('../t/source.jpg');
my ($thumb, $x, $y) = Image::Magick::Thumbnail::create($src,50);
$thumb->Write('source_thumb.jpg');
my ($thumb2, $x2, $y2) = Image::Magick::Thumbnail::create($src,'60x50');
lib/Image/Magick/Thumbnail.pm view on Meta::CPAN
package Image::Magick::Thumbnail;
use strict;
use warnings;
our $VERSION = '0.06';
use Carp;
=head1 NAME
Image::Magick::Thumbnail - Produces thumbnail images with ImageMagick
=head1 SYNOPSIS
use Image::Magick::Thumbnail 0.06;
# Load the source image
my $src = Image::Magick->new;
$src->Read('source.jpg');
# Create the thumbnail from it, where the biggest side is 50 px
my ($thumb, $x, $y) = Image::Magick::Thumbnail::create($src, 50);
# Save your thumbnail
$thumb->Write('source_thumb.jpg');
# Create another thumb, that fits into the geometry
my ($thumb2, $x2, $y2) = Image::Magick::Thumbnail::create($src, '60x50');
# Create yet another thumb, fitting partial geometry
my ($thumb3, $x3, $y3) = Image::Magick::Thumbnail::create($src, 'x50');
__END__
=head1 DESCRIPTION
This module uses the ImageMagick library to create a thumbnail image with no side bigger than you specify.
There is no OO API, since that would seem to be over-kill. There's just C<create>.
=head2 SUBROUTINE create
my ($im_obj, $x, $y) = Image::Magick::Thumbnail->create( $src, $maxsize_or_geometry);
It takes two arguments: the first is an ImageMagick image object,
the second is either the size in pixels you wish the longest side of the image to be,
or an C<Image::Magick>-style 'geometry' (eg C<100x120>) which the thumbnail must fit.
Missing part of the geometry is fine.
Returns an C<Imaeg::Magick> image object (the thumbnail), as well as the
number of pixels of the I<width> and I<height> of the image, as integer scalars,
and (mainly for testing) the ration used in the scaling.
=head2 WARNINGS
Will warn on bad or missing arguments if you have C<use>d C<warnings>.
=head2 PREREQUISITES
Image::Magick
=head2 EXPORTS
None by default.
=head1 SEE ALSO
L<perl>, L<Image::Magick>, L<Image::GD::Thumbnail>,
and L<Image::Thumbnail> for the same formula for various engines.
=head1 AUTHOR
Lee Goddard <LGoddard@CPAN.org>
=head2 COPYRIGT
Copyright (C) Lee Godadrd 2001-2008. all rights reserved.
Available under the same terms as Perl itself.
=cut
use Image::Magick;
use Carp;
#use warnings::register;
sub create($$;$) {
my ($img, $max) = (shift, shift);
if (not $img){
if (warnings::enabled()) {
Carp::cluck "No image";
}
return undef;
}
if (not ref $img or ref $img ne 'Image::Magick'){
if (warnings::enabled()) {
Carp::cluck "Not an Image::Magick object";
}
return undef;
}
if (not $max){
if (warnings::enabled()) {
Carp::cluck "No size or geometry";
}
return undef;
}
BEGIN {
plan tests => 21;
}
SKIP: {
skip "Can't find images", 21
if !-e "t/source.jpg" || !-e "t/source100x200.jpg";
eval {
require Image::Magick;
require Image::Magick::Thumbnail;
};
diag $@ if $@;
skip "This module requires Image::Magick", 21
if $@;
&img_tests;
};
sub img_tests {
my $src = Image::Magick->new;
isa_ok($src, 'Image::Magick');
my $err = $src->Read('t/source.jpg');
BAIL_OUT("Didn't get vry far: ".$err) if $err;
unlink 't/source_thumb.jpg' if -e 't/source_thumb.jpg';
{
my ( $thumb, $x, $y, $r);
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,50);
ok($thumb, 'Got thumb') or BAIL_OUT();
ok ( $x<=50 );
ok ( $y<=50 );
$thumb->Write('t/source_thumb.jpg');
ok (-e 't/source_thumb.jpg');
unlink 't/source_thumb.jpg' if -e 't/source_thumb.jpg';
}
{
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source.jpg');
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'20x50');
ok($thumb);
ok ($x <= 20);
ok ($y <= 50);
}
{
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source100x200.jpg');
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'150x100');
ok($thumb);
ok($x <= 150);
ok($y <= 100);
}
{
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source100x200.jpg');
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'150x100');
ok($thumb);
ok($x <= 150);
ok($y <= 100);
}
{
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source100x200.jpg');
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'x200');
ok($thumb);
ok($x == 100, "y=".$x);
ok($y == 200, "y=".$y);
}
{
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source100x200.jpg');
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'200x');
ok($thumb);
ok($x == 200, "y=".$x);
ok($y == 400, "y=".$y);
}
ERRS: {
no warnings;
my ( $thumb, $x, $y, $r);
$src = Image::Magick->new;
$src->Read('t/source100x200.jpg');
eval {
($thumb,$x,$y) = Image::Magick::Thumbnail::create($src,'-1x');
};
ok(!$thumb);
}
}
=head1 TEST F<test.t>
This script tests the module is acceptable and functions as expected.
( run in 0.344 second using v1.01-cache-2.11-cpan-beeb90c9504 )