Data-FormValidator-Filters-Image

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use Module::Build;

Module::Build->new(
    module_name => 'Data::FormValidator::Filters::Image',
    license => 'perl',
    requires => {
        'Data::FormValidator' => 0,
        'Image::Magick' => 0,
        'MIME::Types' => 0,
        'CGI' => 0,
        'File::Basename' => 0,
        'File::Spec' => 0,
    },
    build_requires => {
        'HTTP::Request::Common' => 0,
        'Image::Size' => 0,
        'IO::Scalar' => 0,
        'File::Slurp' => 0,

META.yml  view on Meta::CPAN

  - 'Cees Hek <ceeshek@gmail.com>'
abstract: Filter that allows you to shrink incoming image uploads when using Data::FormValidator
license: perl
resources:
  license: http://dev.perl.org/licenses/
requires:
  CGI: 0
  Data::FormValidator: 0
  File::Basename: 0
  File::Spec: 0
  Image::Magick: 0
  MIME::Types: 0
build_requires:
  File::Slurp: 0
  HTTP::Request::Common: 0
  IO::Scalar: 0
  Image::Size: 0
provides:
  Data::FormValidator::Filters::Image:
    file: lib/Data/FormValidator/Filters/Image.pm
    version: 0.40

Makefile.PL  view on Meta::CPAN

          'NAME' => 'Data::FormValidator::Filters::Image',
          'VERSION_FROM' => 'lib/Data/FormValidator/Filters/Image.pm',
          'PREREQ_PM' => {
                           'CGI' => 0,
                           'Data::FormValidator' => 0,
                           'File::Basename' => 0,
                           'File::Slurp' => 0,
                           'File::Spec' => 0,
                           'HTTP::Request::Common' => 0,
                           'IO::Scalar' => 0,
                           'Image::Magick' => 0,
                           'Image::Size' => 0,
                           'MIME::Types' => 0
                         },
          'INSTALLDIRS' => 'site',
          'EXE_FILES' => [],
          'PL_FILES' => {}
        )
;

lib/Data/FormValidator/Filters/Image.pm  view on Meta::CPAN

package Data::FormValidator::Filters::Image;

use strict;

use File::Basename;
use Image::Magick;
use IO::File;
use MIME::Types;

=pod

=head1 NAME

Data::FormValidator::Filters::Image - Filter that allows you to shrink incoming image uploads using Data::FormValidator

=head1 SYNOPSIS

lib/Data/FormValidator/Filters/Image.pm  view on Meta::CPAN

    return $fh unless $fh && ref $fh eq 'Fh';
    my $filename = $fh->asString;
    $filename =~ s/^.*[\/\\]//; # strip off any path information that IE puts in the filename
    binmode $fh;

    my ($result, $image);
    eval {
        # turn the Fh from CGI.pm back into a regular Perl filehandle, then
        # let ImageMagick read the image from _that_ fh.
        my $fh_copy = IO::File->new_from_fd(fileno($fh), 'r');
        $image = Image::Magick->new;
        $result = $image->Read( file => $fh_copy );
    };
    if ($@) {
        #warn "Uploaded file was not an image:  $@";
        seek( $fh, 0, 0 );
        return $fh;
    }
    if ("$result") { # quotes are there as per the Image::Magick examples
        #warn "$result";
        seek( $fh, 0, 0 );
        return $fh;
    }

    my ( $nw, $nh ) = my ( $ow, $oh ) = $image->Get( 'width', 'height' );

    unless ( $ow && $oh ) {
        #warn "Image has no width or height";
        seek( $fh, 0, 0 );

lib/Data/FormValidator/Filters/Image.pm  view on Meta::CPAN

        $nw = $ow * ( $max_height / $oh );
    }

    if (($oh <= $max_height) && ($ow <= $max_width)) {
        #warn "Image does not need to be resized";
        seek( $fh, 0, 0 );
        return $fh;
    }

    $result = $image->Resize( width => $nw, height => $nh, @the_rest );
    if ("$result") { # quotes are there as per the Image::Magick examples
        #warn "$result";
        seek( $fh, 0, 0 );
        return $fh;
    }

    #########################
    # Create a file handle object to simulate a CGI.pm upload
    #  Pulled directly from CGI.pm by Lincoln Stein
    my $tmp_filename;
    my $seqno = unpack( "%16C*", join( '', localtime, values %ENV ) );

lib/Data/FormValidator/Filters/Image.pm  view on Meta::CPAN

          if defined( $newfh = Fh->new( $filename, $tmp_filename, 0 ) );
        $seqno += int rand(100);
    }
    die "CGI open of tmpfile: $!\n" unless defined $newfh;
    $CGI::DefaultClass->binmode($newfh)
      if $CGI::needs_binmode
      && defined fileno($newfh);
    #########################

    $image->Write( file => $newfh, filename => $filename );
    if ("$result") { # quotes are there as per the Image::Magick examples
        #warn "$result";
        seek( $fh, 0, 0 );
        return $fh;
    }

    # rewind both filehandles before we return
    seek( $newfh, 0, 0 );
    seek( $fh,    0, 0 );
    return $newfh;
}