view release on metacpan or  search on metacpan

t/Utils.pm  view on Meta::CPAN

package t::Utils;
use strict;
use warnings;

use File::Spec;
use Imager;
use Imager::Color;
use Test::More;

sub import {
    my($class, %args) = @_;
    my $caller = caller(0);

    if (delete $args{want_jpeg}) {
        unless (grep { $_ eq 'jpeg' } Imager->read_types) {
            plan skip_all => 'this test required jpeg support at Imager';
        }
    }

    strict->import;
    warnings->import;

    for my $name (qw/ is_rotated path_to slurp /) {
        no strict 'refs';
        *{"$caller\::$name"} = \&{$name};
    }
}

my $pattern_maps = {
    1 => { x => 5,  y => 5  },
    2 => { x => 25, y => 5  },
    3 => { x => 25, y => 35 },
    4 => { x => 5,  y => 35 },
    5 => { x => 5,  y => 15 },
    6 => { x => 35, y => 5  },
    7 => { x => 35, y => 25 },
    8 => { x => 5,  y => 20 },
};

sub is_rotated {
    my($orientation, $image) = @_;

    my $map = $pattern_maps->{$orientation};

    for my $x (($map->{x}-1)..($map->{x}+1)) {
        for my $y (($map->{y}-1)..($map->{y}+1)) {
            my @color = $image->getpixel( x => $x, y => $y )->rgba;
            ::ok($color[0] > $color[1]+100, "$orientation: $x, $y is R($color[0]) > G($color[1]+100)");
            ::ok($color[0] > $color[2]+200, "$orientation: $x, $y is R($color[0]) > B($color[2]+200)");
        }
    }
}

sub path_to {
    my $file = shift;
    File::Spec->catfile( 't', 'images', 'original', $file );
}

sub slurp {
    my $path = shift;
    open my $fh, '<', $path or die "$!: $path";
    local $/;
    <$fh>;
}

1;