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;