File Coverage

blib/lib/Test/Image/GD.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Test::Image::GD;

use strict;
use warnings;

use Test::Builder ();
use Scalar::Util  'blessed';
use GD            ':cmp';

require Exporter;

our $VERSION = '0.03';
our @ISA     = ('Exporter');
our @EXPORT  = qw(
                 cmp_image
                 size_ok
                 height_ok
                 width_ok
                 );

my $Test = Test::Builder->new;

sub cmp_image ($$;$) {
    my ($got, $expected, $message) = @_;
    _coerce_image($got);
    _coerce_image($expected);

    if ($got->compare($expected) & GD_CMP_IMAGE) {
        $Test->ok(0, $message);
    }
    else {
        $Test->ok(1, $message);
    }
}

sub size_ok ($$;$) {
    my ($got, $expected, $message) = @_;
    _coerce_image($got);
    (ref($expected) && ref($expected) eq 'ARRAY')
        || die "expected must be an ARRAY ref";

    if ($got->width  == $expected->[0] &&
        $got->height == $expected->[1] ){
        $Test->ok(1, $message);
    }
    else {
        $Test->diag("... (image => (width, height))\n" .
                    "   w: (" . $got->width  . " => " . $expected->[0] . ")\n" .
                    "   h: (" . $got->height . " => " . $expected->[1] . ")");
        $Test->ok(0, $message);
    }
}

sub height_ok ($$;$) {
    my ($got, $expected, $message) = @_;
    _coerce_image($got);

    if ($got->height == $expected){
        $Test->ok(1, $message);
    }
    else {
        $Test->diag("... (image => (height))\n" .
                    "   h: (" . $got->height . " => " . $expected . ")");
        $Test->ok(0, $message);
    }
}

sub width_ok ($$;$) {
    my ($got, $expected, $message) = @_;
    _coerce_image($got);

    if ($got->width == $expected){
        $Test->ok(1, $message);
    }
    else {
        $Test->diag("... (image => (width))\n" .
                    "   w: (" . $got->width . " => " . $expected . ")");
        $Test->ok(0, $message);
    }
}

## Utility Methods

sub _coerce_image {
    unless (blessed($_[0]) && $_[0]->isa('GD::Image')) {
        $_[0] = GD::Image->new($_[0])
               || die "Could not create GD::Image instance with : " . $_[0];
    }
}

1;

__END__