Catalyst-Plugin-Upload-Image-Magick
view release on metacpan or search on metacpan
directory:
- inc
- t
requires:
Catalyst: 0
Catalyst::Exception: 0
Catalyst::Request::Upload: 0
Catalyst::Utils: 0
Class::Accessor::Fast: 0
File::Temp: 0
Image::Magick: 0
Image::Magick::Thumbnail::Fixed: 0
version: 0.03
Makefile.PL view on Meta::CPAN
version('0.04');
license('perl');
requires('Catalyst');
requires('Catalyst::Request::Upload');
requires('Catalyst::Utils');
requires('Catalyst::Exception');
requires('Class::Accessor::Fast');
requires('File::Temp');
requires('Image::Magick');
requires('Image::Magick::Thumbnail::Fixed');
use_test_base;
auto_include;
auto_install;
WriteAll;
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the perldoc command.
perldoc Catalyst::Plugin::Upload::Image::Magick
You can also look for information at:
Search CPAN
http://search.cpan.org/dist/Catalyst-Plugin-Upload-Image-Magick
CPAN Request Tracker:
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-Upload-Image-Magick
AnnoCPAN, annotated CPAN documentation:
lib/Catalyst/Plugin/Upload/Image/Magick.pm view on Meta::CPAN
package Catalyst::Plugin::Upload::Image::Magick;
use strict;
use warnings;
use Catalyst::Request::Upload;
use Catalyst::Exception;
use Image::Magick;
=head1 NAME
Catalyst::Plugin::Upload::Image::Magick - Image information plugin for Catalyst::Request::Upload
=head1 VERSION
Version 0.03
=cut
our $VERSION = '0.03';
=head1 SYNOPSIS
In your L<Catalyst> project,
use Catalyst qw/Upload::Image::Magick/;
And you can execute method around image information in L<Catalyst::Request::Image> object;
sub uploaded_action: Local {
my ($self, $c) = shift;
$upload = $c->request->upload('file_field');
if ($upload->is_image) {
$c->log->debug("width : " . $upload->width);
lib/Catalyst/Plugin/Upload/Image/Magick.pm view on Meta::CPAN
=cut
{
package Catalyst::Request::Upload;
sub image {
my $self = shift;
unless ( $self->{_image} ) {
my $image = Image::Magick->new;
return undef if ( !$self->type || [ split( '/', $self->type ) ]->[0] ne 'image' );
my $result = $image->Read( file => $self->fh );
Catalyst::Exception->throw($result) if ($result);
$self->{_image} = $image;
}
return $self->{_image};
}
lib/Catalyst/Plugin/Upload/Image/Magick.pm view on Meta::CPAN
return $self->image->get($method) if ( $self->image );
return undef;
};
}
}
=head1 METHODS
=head2 image()
If uploaded file is image, then return L<Image::Magick> object,
is't image then throw L<Catalyst::Exception>.
=head2 is_image()
If uploaded file is image, then return 1, else 0.
=head2 width()
If uploaded file is image, then return image width, else undef.
lib/Catalyst/Plugin/Upload/Image/Magick.pm view on Meta::CPAN
Toru Yamaguchi, C<< <zigorou at cpan.org> >>
=head1 SEE ALSO
=over 2
=item L<Catalyst>
=item L<Catalyst::Request::Upload>
=item L<Image::Magick>
=back
=head1 BUGS
Please report any bugs or feature requests to
C<bug-catalyst-plugin-upload-image-magick at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-Upload-Image-Magick>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Catalyst::Plugin::Upload::Image::Magick
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Catalyst-Plugin-Upload-Image-Magick>
=item * CPAN Ratings
lib/Catalyst/Plugin/Upload/Image/Magick.pm view on Meta::CPAN
=head1 COPYRIGHT & LICENSE
Copyright 2006 Toru Yamaguchi, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Catalyst::Plugin::Upload::Image::Magick
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail.pm view on Meta::CPAN
package Catalyst::Plugin::Upload::Image::Magick::Thumbnail;
use strict;
use warnings;
use Catalyst::Request::Upload;
use Catalyst::Utils;
use Catalyst::Exception;
use File::Temp;
use Image::Magick;
=head1 NAME
Catalyst::Plugin::Upload::Image::Magick::Thumbnail - Making thumbnail image is kept ratio, resized to specified size or less.
=head1 VERSION
Version 0.04
=cut
our $VERSION = '0.04';
=head1 SYNOPSIS
In your Catalyst project,
use Catalyst qw/Upload::Image::Magick::Thumbnail/;
You can execute "thumbnail" method in Catalyst::Request::Upload object
sub resize_to: Local {
my ($self, $c) = @_;
my $upload = $c->request->upload('file_field');
my $thumbnail = $upload->thumbnail({
density => '60x70',
format => 'png',
quality => 100
});
# $thumbnail is Image::Magick object
my ($width, $height) = $thumbnail->Get('width', 'height');
# ...
}
=head1 DESCRIPTION
This module is almost same usage L<Image::Magick::Thumbnail>.
But I tried it, I was not able to be satisfied with the result.
In making thumbnail image, it usually is most important that
thumbnail should be stored in the specified size or less.
But L<Image::Magick::Thumbnail> module is wrong about this.
In making thumbnail made by this module,
it is made to approach the specified size unlimitedly
and kept original ratio.
=head1 METHODS
=head2 thumbnail($args)
Create thumbnail image.
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail.pm view on Meta::CPAN
Default value is jpg.
=item quality
Image quality option. highest value is 100.
minimam value is 0. default 70.
=item gravity
Optional parameter.
Default center. See L<Image::Magick::Thumbnail::Fixed>.
=item compose
Optional parameter.
Default over. See L<Image::Magick::Thumbnail::Fixed>.
=item bgcolor
Optional parameter.
Default white. See L<Image::Magick::Thumbnail::Fixed>.
=back
=back
See also L<Image::Magick::Thumbnail>, L<Image::Magick::Thumbnail::Fixed>
=cut
{
package Catalyst::Request::Upload;
sub thumbnail {
my ( $self, $args ) = @_;
Catalyst::Exception->throw(
"Please require Catalyst::Plugin::Upload::Image::Magick")
unless ( $self->can("is_image") );
Catalyst::Exception->throw(
"This file is not image : " . $self->filename )
unless ( $self->is_image );
my $density;
if ( exists $args->{density} ) {
$density = $args->{density};
}
elsif ( exists $args->{size} ) {
$density = $args->{size} . "x" . $args->{size};
}
else {
$density = "60x60";
}
$args->{format} = "jpg" unless ( exists $args->{format} );
$args->{output} = File::Temp->new(
DIR => Catalyst::Utils::class2tempdir(
"Catalyst::Plugin::Upload::Image::Magick::Thumbnail", 1
),
TEMPLATE => "thumbnail_XXXXXX",
EXT => $args->{format}
);
my $thumbnail = $self->image->Clone;
my ( $src_width, $src_height ) = $thumbnail->Get( 'width', 'height' );
my ( $dest_width, $dest_height ) =
map { s/[^\d]+//g; $_ } split( /x/, $density );
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail.pm view on Meta::CPAN
Please report any bugs or feature requests to
C<bug-catalyst-plugin-upload-image-magick-thumbnail at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-Upload-Image-Magick>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Catalyst::Plugin::Upload::Image::Magick
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Catalyst-Plugin-Upload-Image-Magick>
=item * CPAN Ratings
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail.pm view on Meta::CPAN
=head1 COPYRIGHT & LICENSE
Copyright 2006 Toru Yamaguchi, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Catalyst::Plugin::Upload::Image::Magick::Thumbnail
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail/Fixed.pm view on Meta::CPAN
package Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed;
use strict;
use warnings;
use Catalyst::Request::Upload;
use Catalyst::Utils;
use Catalyst::Exception;
use File::Temp;
use Image::Magick;
use Image::Magick::Thumbnail::Fixed;
=head1 NAME
Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed - Making thumbnail image is kept ratio in fixed size image.
=head1 VERSION
Version 0.04
=cut
our $VERSION = '0.04';
=head1 SYNOPSIS
In your Catalyst project,
use Catalyst qw/Upload::Image::Magick::Thumbnail::Fixed/;
You can execute "thumbnail_fixed" method in Catalyst::Request::Upload object
sub resize_to: Local {
my ($self, $c) = @_;
my $upload = $c->request->upload('file_field');
my $thumbnail = $upload->thumbnail_fixed({
density => '60x70',
format => 'png',
quality => 100
});
# $thumbnail is Image::Magick object
my ($width, $height) = $thumbnail->Get('width', 'height');
# ...
}
=head1 METHODS
=head2 thumbnail_fixed($args)
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail/Fixed.pm view on Meta::CPAN
=item quality
Image quality option. highest value is 100.
minimam value is 0. default 70.
=back
=back
See also L<Image::Magick::Thumbnail>, L<Image::Magick::Thumbnail::Fixed>
=cut
{
package Catalyst::Request::Upload;
sub thumbnail_fixed {
my ( $self, $args ) = @_;
Catalyst::Exception->throw(
"Please require Catalyst::Plugin::Upload::Image::Magick")
unless ( $self->can("is_image") );
Catalyst::Exception->throw(
"This file is not image : " . $self->filename )
unless ( $self->is_image );
unless ( $self->{_thumbnail_fixed} ) {
$self->{_thumbnail_fixed} = Image::Magick::Thumbnail::Fixed->new;
}
if ( exists $args->{density} && $args->{density} =~ m|\d+x\d+| ) {
( $args->{width}, $args->{height} ) =
map { s/\s+//g; $_ } split( /x/, $args->{density} );
delete $args->{density};
}
else {
$args->{width} = 60 unless ( exists $args->{width} );
$args->{height} = 60 unless ( exists $args->{height} );
}
$args->{format} = "jpg" unless ( exists $args->{format} );
$args->{input} = $self->tempname;
$args->{output} = File::Temp->new(
DIR => Catalyst::Utils::class2tempdir(
"Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed", 1
),
TEMPLATE => "thumbnail_XXXXXX",
EXT => $args->{format}
);
eval { $self->{_thumbnail_fixed}->thumbnail(%$args); };
if ($@) {
Catalyst::Exception->throw($@);
}
elsif ( !-e $args->{output} ) {
Catalyst::Exception->throw(
"Can't create thumbnail : " . $args->{output} );
}
my $thumb = Image::Magick->new;
$thumb->Read( $args->{output} );
### for File::Temp's cleanup
$self->{_thumbnail_temp} = {} unless ($self->{_thumbnail_temp});
$self->{_thumbnail_temp}->{ $thumb->Get('filename') } = $args->{output};
return $thumb;
}
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail/Fixed.pm view on Meta::CPAN
Please report any bugs or feature requests to
C<bug-catalyst-plugin-upload-image-magick-thumbnail-fixed at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-Upload-Image-Magick>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Catalyst::Plugin::Upload::Image::Magick
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Catalyst-Plugin-Upload-Image-Magick>
=item * CPAN Ratings
lib/Catalyst/Plugin/Upload/Image/Magick/Thumbnail/Fixed.pm view on Meta::CPAN
=head1 COPYRIGHT & LICENSE
Copyright 2006 Toru Yamaguchi, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed
t/00-load.t view on Meta::CPAN
#!perl -T
use lib qw(inc);
use Test::More tests => 3;
use_ok('Catalyst::Plugin::Upload::Image::Magick');
use_ok('Catalyst::Plugin::Upload::Image::Magick::Thumbnail');
use_ok('Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed');
diag(
"Testing Catalyst::Plugin::Upload::Image::Magick $Catalyst::Plugin::Upload::Image::Magick::VERSION, Perl $], $^X"
);
t/01-upload-with-image-magick.t view on Meta::CPAN
#!perl -T
use lib qw(lib .);
use Test::Base tests => 16;
require 't/setup.pl';
use Catalyst::Request::Upload;
use Catalyst::Plugin::Upload::Image::Magick;
ok( Catalyst::Request::Upload->can("image") );
ok( Catalyst::Request::Upload->can("is_image") );
ok( Catalyst::Request::Upload->can("width") );
ok( Catalyst::Request::Upload->can("height") );
sub test_image {
my $filename = shift;
my $upload = setup($filename);
return ref $upload->image;
t/01-upload-with-image-magick.t view on Meta::CPAN
sub test_height {
my $filename = shift;
my $upload = setup($filename);
return $upload->height . "px";
}
run_is input => 'expected';
__END__
=== test create Image::Magick instance 1
--- input chomp test_image
./t/images/cpan-10.jpg
--- expected chomp
Image::Magick
=== test create Image::Magick instance 2
--- input chomp test_image
./t/images/lcamel.gif
--- expected chomp
Image::Magick
=== test create Image::Magick instance 3
--- input chomp test_image
./t/images/script.png
--- expected chomp
Image::Magick
=== test is_image 1
--- input chomp test_is_image
./t/images/cpan-10.jpg
--- expected chomp
ok
=== test is_image 2
--- input chomp test_is_image
./t/images/lcamel.gif
t/02-upload-to-thumbnail.t view on Meta::CPAN
#!perl -T
use lib qw(lib .);
use Test::Base tests => 1801;
require 't/setup.pl';
use Catalyst::Request::Upload;
use Catalyst::Plugin::Upload::Image::Magick;
use Catalyst::Plugin::Upload::Image::Magick::Thumbnail;
use Image::Magick;
ok( Catalyst::Request::Upload->can("thumbnail") );
sub test_image {
my ( $filename, $format, $width, $height ) = @_;
my $upload = setup($filename);
return $upload->thumbnail(
{
density => $width . "x" . $height,
quality => 100,
format => $format
}
);
}
for my $format (qw/jpg gif png/) {
for my $filename ( glob("t/images/*") ) {
my $src = Image::Magick->new;
$src->Read($filename);
for ( my $width = 10 ; $width <= 100 ; $width += 10 ) {
for ( my $height = 10 ; $height <= 100 ; $height += 10 ) {
my $image = test_image( $filename, $format, $width, $height );
ok( $image, "Create thumbnail : ${width}x${height}" );
ok(
$image->Get('width') * $image->Get('height') <=
t/03-upload-to-thumbnail-fixed.t view on Meta::CPAN
#!perl -T
use lib qw(lib .);
use Test::Base tests => 2701;
require 't/setup.pl';
use Catalyst::Request::Upload;
use Catalyst::Plugin::Upload::Image::Magick;
use Catalyst::Plugin::Upload::Image::Magick::Thumbnail::Fixed;
ok( Catalyst::Request::Upload->can("thumbnail_fixed") );
sub test_image {
my ( $filename, $format, $width, $height ) = @_;
my $upload = setup($filename);
return $upload->thumbnail_fixed(
{
density => $width . "x" . $height,
( run in 1.668 second using v1.01-cache-2.11-cpan-beeb90c9504 )