The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use lib './t';

use CGI;
use Config;
use File::Spec;
use Data::FormValidator;
use Data::FormValidator::Filters::Image;

# We don't use any of the standard Test modules, because I couldn't
# figure out how to get Test::More to work in a forked environment.
# Test::Harness wouldn't see any of the output, so the tests showed up
# as failed.  The old fashion way works just as well though.

$| = 1;

# test function from CGI.pm
sub test {
    local ($^W) = 0;
    my ( $num, $true, $msg ) = @_;
    print( $true ? "ok $num $msg\n" : "not ok $num $msg\n" );
}

print "1..32\n";

unless ( $Config{d_fork} ) {
    test( $_, 1, "# skip fork not available on this platform" ) for 1 .. 32;
    exit;
}
else {
    test( 1, 1, 'fork required for these tests' );
}

eval { require HTTP::Request::Common; };
if ($@) {
    test( $_, 1, "# skip HTTP::Request::Common required for these test" )
      for 2 .. 32;
    exit;
}
else {
    test( 2, 1, 'HTTP::Request::Common required for these tests' );
}

my $image_info_not_available = 0;
eval { require Image::Info; };
if ($@) {
    $image_info_not_available = 1;
}

# Create a request

# Fake a web server CGI request by building a proper
# POST request, setting some ENV variables and
# forking a child process that gets the POST
# content from STDIN
my $req = &HTTP::Request::Common::POST(
    '/dummy_location',
    Content_Type => 'form-data',
    Content      => [
        name   => 'name1',
        test   => 'name2',
        image1 => ["t/image.jpg"],
        image2 => ["t/image.jpg"],
        image3 => ["t/image.jpg"],
        image4 => ["t/image.jpg"],
        image5 => ["t/image.jpg"],
        image6 => ["t/empty.jpg"],
        file   => ["t/file.txt"],
    ]
);
$ENV{REQUEST_METHOD} = 'POST';
$ENV{CONTENT_TYPE}   = 'multipart/form-data';
$ENV{CONTENT_LENGTH} = $req->content_length;
if ( open( CHILD, "|-" ) ) {    # cparent
    print CHILD $req->content;
    close CHILD;
    exit 0;
}

# at this point, we're in a new (child) process
# and CGI.pm can read the POST params from STDIN
# as in a real request
my $q = CGI->new;

my $profile = {
    required => [qw(image1 image2 image3 image4 image5 image6 file name)],
    field_filters => {
        image1 => Data::FormValidator::Filters::Image::image_filter(
            max_width  => 75,
            max_height => 50,
        ),
        image2 => Data::FormValidator::Filters::Image::image_filter(
            max_width  => 50,
            max_height => 75,
        ),
        image3 => Data::FormValidator::Filters::Image::image_filter(
            max_width => 50,
        ),
        image4 => Data::FormValidator::Filters::Image::image_filter(
            max_height => 50,
        ),
        image5 => Data::FormValidator::Filters::Image::image_filter(),
        image6 => Data::FormValidator::Filters::Image::image_filter(
            max_width  => 50,
            max_height => 50,
        ),
        file => Data::FormValidator::Filters::Image::image_filter(
            max_width  => 50,
            max_height => 50,
        ),
        name => Data::FormValidator::Filters::Image::image_filter(
            max_width  => 50,
            max_height => 50,
        ),
    },
};

my $results = Data::FormValidator->check( $q, $profile );

test( 3, $results, "Data::FormValidator check" );

my $valid = $results->valid;

# Test Image #1
#
#            max_width  => 75,
#            max_height => 50,
#
my $fh = $valid->{image1};

test( 4, ref $fh eq 'Fh', "valid Fh object" );

my $filename = File::Spec->catdir( 't', 'sh_' . $fh->asString );
unlink $filename if -e $filename;
if ($fh) {
    open( my $newfh, '>', $filename )
        || die "Can't open temp image filename $filename";
    my $buffer;
    while ( sysread $fh, $buffer, 4096 ) {
        print $newfh $buffer;
    }
    close $newfh;
}

test( 5, -e $filename, "Temporary image saved" );

if ($image_info_not_available) {
    test( $_, 1, "# skip Image::Info required for these test" ) for 6 .. 8;
}
else {
    my $info = Image::Info::image_info($filename);
    test( 6, !$info->{error}, "Image::Info results" );
    my ( $w, $h ) = Image::Info::dim($info);
    test( 7, $info->{width} == 37, "Width is 37" );
    test( 8, $info->{height} == 50, "Height is 50" );
}

# Test Image #2
#
#            max_width  => 50,
#            max_height => 75,
#
$fh = $valid->{image2};

test( 9, ref $fh eq 'Fh', "valid Fh object" );

$filename = File::Spec->catdir( 't', 'sh_' . $fh->asString );
unlink $filename if -e $filename;
if ($fh) {
    open( my $newfh, '>', $filename )
        || die "Can't open temp image filename $filename";
    my $buffer;
    while ( sysread $fh, $buffer, 4096 ) {
        print $newfh $buffer;
    }
    close $newfh;
}

test( 10, -e $filename, "Temporary image saved" );

if ($image_info_not_available) {
    test( $_, 1, "# skip Image::Info required for these test" ) for 11 .. 13;
}
else {
    my $info = Image::Info::image_info($filename);
    test( 11, !$info->{error}, "Image::Info results" );
    my ( $w, $h ) = Image::Info::dim($info);
    test( 12, $info->{width} == 50, "Width is 50" );
    test( 13, $info->{height} == 66, "Height is 66" );
}

# Test Image #3
#
#            max_width  => 50,
#
$fh = $valid->{image3};

test( 14, ref $fh eq 'Fh', "valid Fh object" );

$filename = File::Spec->catdir( 't', 'sh_' . $fh->asString );
unlink $filename if -e $filename;
if ($fh) {
    open( my $newfh, '>', $filename )
        || die "Can't open temp image filename $filename";
    my $buffer;
    while ( sysread $fh, $buffer, 4096 ) {
        print $newfh $buffer;
    }
    close $newfh;
}

test( 15, -e $filename, "Temporary image saved" );

if ($image_info_not_available) {
    test( $_, 1, "# skip Image::Info required for these test" ) for 16 .. 18;
}
else {
    my $info = Image::Info::image_info($filename);
    test( 16, !$info->{error}, "Image::Info results" );
    my ( $w, $h ) = Image::Info::dim($info);
    test( 17, $info->{width} == 50, "Width is 50" );
    test( 18, $info->{height} == 66, "Height is 66" );
}

# Test Image #4
#
#            max_height  => 50,
#
$fh = $valid->{image4};

test( 19, ref $fh eq 'Fh', "valid Fh object" );

$filename = File::Spec->catdir( 't', 'sh_' . $fh->asString );
unlink $filename if -e $filename;
if ($fh) {
    open( my $newfh, '>', $filename )
        || die "Can't open temp image filename $filename";
    my $buffer;
    while ( sysread $fh, $buffer, 4096 ) {
        print $newfh $buffer;
    }
    close $newfh;
}

test( 20, -e $filename, "Temporary image saved" );

if ($image_info_not_available) {
    test( $_, 1, "# skip Image::Info required for these test" ) for 21 .. 23;
}
else {
    my $info = Image::Info::image_info($filename);
    test( 21, !$info->{error}, "Image::Info results" );
    my ( $w, $h ) = Image::Info::dim($info);
    test( 22, $info->{width} == 37, "Width is 37" );
    test( 23, $info->{height} == 50, "Height is 50" );
}

# Test Image #5
#
#
$fh = $valid->{image5};

test( 24, ref $fh eq 'Fh', "valid Fh object" );

$filename = File::Spec->catdir( 't', 'sh_' . $fh->asString );
unlink $filename if -e $filename;
if ($fh) {
    open( my $newfh, '>', $filename )
        || die "Can't open temp image filename $filename";
    my $buffer;
    while ( sysread $fh, $buffer, 4096 ) {
        print $newfh $buffer;
    }
    close $newfh;
}

test( 25, -e $filename, "Temporary image saved" );

if ($image_info_not_available) {
    test( $_, 1, "# skip Image::Info required for these test" ) for 26 .. 28;
}
else {
    my $info = Image::Info::image_info($filename);
    test( 26, !$info->{error}, "Image::Info results" );
    my ( $w, $h ) = Image::Info::dim($info);
    test( 27, $info->{width} == 75, "Width is 50" );
    test( 28, $info->{height} == 100, "Height is 66" );
}

# Test Image #6
#
# Run the image_filter over an invalid (empty) image file
#
$fh = $valid->{image6};
test( 29, ref $fh eq 'Fh', "valid Fh object" );

# Test File
#
# Run the image_filter of a text file
#
$fh = $valid->{file};

test( 30, ref $fh eq 'Fh', "valid Fh object" );

my @lines = <$fh>;
chomp $lines[0];
test(
    31,
    $lines[0] eq 'This is a dummy file',
    "Text file wasn't clobbered"
);

# Test 'name' field
#
# We ran the image_filter over a value that was just a plain string
test( 32, $valid->{name} eq 'name1', "Data::FormValidator check" );