File Coverage

blib/lib/Data/FormValidator/Constraints/Upload.pm

Criterion	Covered	Total	%
statement	19	164	11.5
branch	0	52	0.0
condition	1	45	2.2
subroutine	5	20	25.0
pod	4	8	50.0
total	29	289	10.0

package Data::FormValidator::Constraints::Upload;
use Exporter 'import';
use strict;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration   use Data::FormValidator::Constraints::Upload ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

our @EXPORT = qw(
    valid_file_format
    valid_image_max_dimensions
    valid_file_max_bytes
    valid_image_min_dimensions
);

our @EXPORT_OK = qw(
    file_format
    image_max_dimensions
    file_max_bytes
    image_min_dimensions
);

our $VERSION = 4.85;

sub file_format {
    my %params = @_;
    return sub {
        my $self = shift;
        $self->set_current_constraint_name('file_format');
        valid_file_format($self,\%params);
    }
}

sub image_max_dimensions {
    my $w  = shift || die 'image_max_dimensions: missing maximum width value';
    my $h  = shift || die 'image_max_dimensions: missing maximum height value';
    return sub {
        my $self = shift;
        $self->set_current_constraint_name('image_max_dimensions');
        valid_image_max_dimensions($self,\$w,\$h);
    }
}

sub file_max_bytes {
    my ($max_bytes) = @_;
    return sub {
        my $self = shift;
        $self->set_current_constraint_name('file_max_bytes');
        valid_file_max_bytes($self,\$max_bytes);
    }
}

sub image_min_dimensions {
    my $w  = shift || die 'image_min_dimensions: missing minimum width value';
    my $h  = shift || die 'image_min_dimensions: missing minimum height value';
    return sub {
        my $self = shift;
        $self->set_current_constraint_name('image_min_dimensions');
        valid_image_min_dimensions($self,\$w,\$h);
    }
}

sub valid_file_format {
    my $self = shift;
    $self->isa('Data::FormValidator::Results') ||
        die "file_format: first argument is not a Data::FormValidator::Results object. ";
    my $params = shift || {};
    # if (ref $params ne 'HASH' ) {
    #   die "format: hash reference expected. Make sure you have
    #   included 'params => []' in your constraint definition, even if there
    #   are no additional arguments";
    # }
    my $q = $self->get_filtered_data;

    my $field = $self->get_current_constraint_field;
    my $fh = _get_upload_fh($self);

    ## load filehandle
    if (!$fh) {
         warn "$0: can't get filehandle for field named $field" and return undef;
    }

    ## load file magic stuff
    require File::MMagic;
    my $mm = File::MMagic->new;
    my $fm_mt;

    ## only use filehandle bits for magic data
      $fm_mt = $mm->checktype_filehandle($fh) ||
        (warn "$0: can't get filehandle for field named $field" and return undef);
        # Work around a bug in File::MMagic (RT#12074)
        seek($fh,0,0);

    # File::MMagic returns 'application/octet-stream" as a punt
    # for "I don't know, here's a generic binary MIME type.
    # In some cases that is has indicated a bug in File::MMagic,
    # but it's a generally worthless response for identifying the file type.
    # so, we throw away the response in that case. The uploaded MIME type
    # will be used instead later, if present
    $fm_mt = undef if ($fm_mt eq 'application/octet-stream');


    ## fetch mime type universally (or close)
    my $uploaded_mt = _get_upload_mime_type($self);

   # try the File::MMagic, then the uploaded field, then return undef we find neither
   my $mt = ($fm_mt || $uploaded_mt) or return undef;

   # figure out an extension
   use MIME::Types;
   my $mimetypes = MIME::Types->new;
   my MIME::Type $t = $mimetypes->type($mt);
   my @mt_exts = $t ? $t->extensions : ();

    ## setup filename to retrieve extension
    my $fn = $self->get_input_data->param($field);
    my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/);
   my $ext;

   if (scalar @mt_exts) {
        # If the upload extension is one recognized by MIME::Type, use it.
        if (grep {/^$uploaded_ext$/} @mt_exts)   {
            $ext = $uploaded_ext;
        }
        # otherwise, use one from MIME::Type, just to be safe
        else {
            $ext = $mt_exts[0];
        }
   }
   else {
       # If is a provided extension but no MIME::Type extension, use that.
       # It's possible that there no extension uploaded or found)
       $ext = $uploaded_ext;
   }

   # Add the mime_type and extension to the valid data set
   my $info = $self->meta($field) || {};
   $info = { %$info, mime_type => $mt, extension => ".$ext" };
   $self->meta($field,$info);

   return _is_allowed_type($mt, $params);
}

## Returns true if the passed-in mime-type matches our allowed types
sub _is_allowed_type {
    my $mt     = shift;
    my $params = shift;

    # XXX perhaps this should be in a global variable so it's easier
    # for other apps to change the defaults;
    $params->{mime_types} ||= [qw!image/jpeg image/pjpeg image/gif image/png!];
    my %allowed_types = map { $_ => 1 } @{ $params->{mime_types} };

    return $allowed_types{lc $mt};
}


sub valid_image_max_dimensions {
    my $self = shift;
    $self->isa('Data::FormValidator::Results') ||
        die "image_max_dimensions: first argument is not a Data::FormValidator::Results object. ";
    my $max_width_ref  = shift || die 'image_max_dimensions: missing maximum width value';
    my $max_height_ref = shift || die 'image_max_dimensions: missing maximum height value';
    my $max_width  = $$max_width_ref;
    my $max_height = $$max_height_ref;
    ($max_width > 0) || die 'image_max_dimensions: maximum width must be > 0';
    ($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0';

    my $q = $self->get_filtered_data;
    my $field = $self->get_current_constraint_field;
    my ($width,$height) = _get_img_size($self);

    unless ($width) {
        warn "$0: imgsize test failed";
        return undef;
    }

   # Add the dimensions to the valid hash
   my $info = $self->meta($field) || {};
   $info = { %$info, width => $width, height => $height };
   $self->meta($field,$info);

    return (($width <= $$max_width_ref) and ($height <= $$max_height_ref));
}

sub valid_file_max_bytes {
    my $self = shift;

    $self->isa('Data::FormValidator::Results') ||
        die "first argument is not a Data::FormValidator::Results object.";

    my $max_bytes_ref = shift;
    my $max_bytes;

    if ((ref $max_bytes_ref) and defined $$max_bytes_ref) {
        $max_bytes = $$max_bytes_ref;
    }
    else {
        $max_bytes = 1024*1024; # default to 1 Meg
    }

    my $q = $self->get_filtered_data;

    my $field = $self->get_current_constraint_field;

    ## retrieve upload fh for field
    my $fh = _get_upload_fh($self);
    if (!$fh) { warn "Failed to load filehandle for $field" && return undef; }

    ## retrieve size
    my $file_size = (stat ($fh))[7];

   # Add the size to the valid hash
   my $info = $self->meta($field) || {};
   $info = { %$info, bytes => $file_size  };
   $self->meta($field,$info);

   return ($file_size <= $max_bytes);
}

sub valid_image_min_dimensions {
    my $self = shift;
    $self->isa('Data::FormValidator::Results') ||
        die "image_min_dimensions: first argument is not a Data::FormValidator::Results object. ";
    my $min_width_ref  = shift ||
        die 'image_min_dimensions: missing minimum width value';
    my $min_height_ref = shift ||
        die 'image_min_dimensions: missing minimum height value';
    my $min_width  = $$min_width_ref;
    my $min_height = $$min_height_ref;

    ## do these matter?
    ($min_width > 0)  || die 'image_min_dimensions: minimum width must be > 0';
    ($min_height > 0) || die 'image_min_dimensions: minimum height must be > 0';

    my $q = $self->get_filtered_data;
    my $field = $self->get_current_constraint_field;
    my ($width, $height) = _get_img_size($self);

    unless ($width) {
        warn "image failed processing";
        return undef;
    }

    # Add the dimensions to the valid hash
    my $info = $self->meta($field) || {};
    $info = { %$info, width => $width, height => $height };
    $self->meta($field,$info);

    return (($width >= $min_width) and ($height >= $min_height));
}

sub _get_img_size
{
    my $self = shift;
    my $q    = $self->get_filtered_data;

    ## setup caller to make can errors more useful
    my $caller = (caller(1))[3];
    my $pkg  = __PACKAGE__ . "::";
    $caller =~ s/$pkg//g;

    my $field = $self->get_current_constraint_field;

    ## retrieve filehandle from query object.
    my $fh = _get_upload_fh($self);

    ## check error
    if (not $fh) {
        warn "Unable to load filehandle";
        return undef;
    }

    require Image::Size;
    import  Image::Size;

    ## check size
    my ($width, $height, $err) = imgsize($fh);

    unless ($width) {
        warn "$caller: imgsize test failed: $err";
        return undef;
    }

    return ($width, $height);
}

## fetch filehandle for use with various file type checking
## call it with (_get_upload_fh($self)) since kind of mock object
sub _get_upload_fh
{
    my $self  = shift;
    my $q     = $self->get_filtered_data;
    my $field = $self->get_current_constraint_field;

    # convert the FH for the filtered data into a -seekable- handle;
    # depending on whether we're using CGI::Simple, CGI, or Apache::Request
    # we might not have something -seekable-.
    use IO::File;

    if (ref $q->{$field} eq 'IO::File') {
        return $q->{$field};
    }
    else {
        return IO::File->new_from_fd(fileno($q->{$field}), 'r');
    }
}

## returns mime type if included as part of the send
##
## NOTE: retrieves from original uploaded, -UNFILTERED- data
sub _get_upload_mime_type
{
    my $self  = shift;
    my $q     = $self->get_input_data;
    my $field = $self->get_current_constraint_field;

    if ($q->isa('CGI')) {
        my $fn = $q->param($field);

        ## nicely check for info
        if ($q->uploadInfo($fn)) {
            return $q->uploadInfo($fn)->{'Content-Type'}
        }

        return undef;
    }

    if ($q->isa('CGI::Simple')) {
        my $fn = $q->param($field);
        return $q->upload_info($fn, 'mime');
    }

    if ($q->isa('Apache::Request')) {
        my $upload = $q->upload($field);
        return $upload->info('Content-type');
    }

    return undef;
}


1;
__END__