1use strict;
2
3use File::Path ();
4use File::Spec::Functions;
5use FindBin ();
6use Test::More;
7require Test::NoWarnings;
8
9use Image::Scale;
10
11my $gif_version = Image::Scale->gif_version();
12my $png_version = Image::Scale->png_version();
13
14if ($gif_version) {
15    plan tests => 18;
16}
17else {
18    plan skip_all => 'Image::Scale not built with giflib support';
19}
20
21my $tmpdir = catdir( $FindBin::Bin, 'tmp' );
22if ( -d $tmpdir ) {
23    File::Path::rmtree($tmpdir);
24}
25mkdir $tmpdir;
26
27my @types = qw(
28    transparent
29    white
30    interlaced_256
31);
32
33my @resizes = qw(
34    resize_gd_fixed_point
35);
36
37# width/height
38for my $type ( @types ) {
39    my $im = Image::Scale->new( _f("${type}.gif") );
40
41    is( $im->width, 160, "GIF $type width ok" );
42    is( $im->height, 120, "GIF $type height ok" );
43}
44
45# Normal width resize
46SKIP:
47{
48    skip "PNG support not built, skipping file comparison tests", 3 if !$png_version;
49
50    for my $resize ( @resizes ) {
51        for my $type ( @types ) {
52            my $outfile = _tmp("${type}_${resize}_w100.png");
53
54            my $im = Image::Scale->new( _f("${type}.gif") );
55            $im->$resize( { width => 100 } );
56            $im->save_png($outfile);
57
58            is( _compare( _load($outfile), "${type}_${resize}_w100.png" ), 1, "GIF $type $resize 100 file ok" );
59        }
60    }
61}
62
63# corrupt file
64{
65    no strict 'subs';
66    no warnings;
67
68    Test::NoWarnings::clear_warnings();
69
70    my $im = Image::Scale->new( _f("corrupt.gif") );
71
72    # Hide stderr
73    open OLD_STDERR, '>&', STDERR;
74    close STDERR;
75
76    my $ok = $im->resize_gd_fixed_point( { width => 50 } );
77
78    # Restore stderr
79    open STDERR, '>&', OLD_STDERR;
80
81    is( $ok, 0, 'GIF corrupt failed resize ok' );
82
83    # Test that the correct warning was output
84    like( (Test::NoWarnings::warnings())[0]->getMessage, qr/Image::Scale unable to read GIF file/i, 'GIF corrupt error output ok' );
85}
86
87# multiple resize calls on same $im object, should throw away previous resize data
88SKIP:
89{
90    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
91
92    my $outfile = _tmp("transparent_multiple_resize_gd_fixed_point.png");
93    my $im = Image::Scale->new( _f("transparent.gif") );
94    $im->resize_gd_fixed_point( { width => 50 } );
95    $im->resize_gd_fixed_point( { width => 100 } );
96    $im->save_png($outfile);
97
98    is( _compare( _load($outfile), "transparent_multiple_resize_gd_fixed_point.png" ), 1, "GIF multiple resize_gd_fixed_point ok" );
99}
100
101# resize from GIF in scalar
102SKIP:
103{
104    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
105
106    my $dataref = _load( _f("transparent.gif") );
107
108    my $outfile = _tmp("transparent_resize_gd_fixed_point_w100_scalar.png");
109    my $im = Image::Scale->new($dataref);
110    $im->resize_gd_fixed_point( { width => 100 } );
111    $im->save_png($outfile);
112
113    is( _compare( _load($outfile), "transparent_resize_gd_fixed_point_w100.png" ), 1, "GIF resize_gd_fixed_point from scalar ok" );
114}
115
116# resize multiple from GIF scalar
117SKIP:
118{
119    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
120
121    my $dataref = _load( _f("transparent.gif") );
122
123    my $outfile = _tmp("transparent_multiple_resize_gd_fixed_point_w100_scalar.png");
124    my $im = Image::Scale->new($dataref);
125    $im->resize_gd_fixed_point( { width => 150 } );
126    $im->resize_gd_fixed_point( { width => 100 } );
127    $im->save_png($outfile);
128
129    is( _compare( _load($outfile), "transparent_resize_gd_fixed_point_w100.png" ), 1, "GIF resize_gd_fixed_point multiple from scalar ok" );
130}
131
132# offset image in MP3 ID3v2 tag
133SKIP:
134{
135    my $outfile = _tmp("apic_gd_fixed_point_w100.png");
136    my $im = Image::Scale->new(
137        _f('v2.4-apic-gif-318-5169.mp3'),
138        { offset => 318, length => 5169 }
139    );
140
141    is( $im->width, 160, 'GIF from offset ID3 tag width ok' );
142    is( $im->height, 120, 'GIF from offset ID3 tag height ok' );
143
144    $im->resize_gd_fixed_point( { width => 100 } );
145
146    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
147
148    $im->save_png($outfile);
149
150    is( _compare( _load($outfile), "apic_gd_fixed_point_w100.png" ), 1, "GIF resize_gd_fixed_point from offset ID3 tag ok" );
151}
152
153# Bug 17573, very thin gif could cause divide by 0 errors
154SKIP:
155{
156    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
157
158    my $outfile = _tmp("bug17573-thin_gd_fixed_point_w40.png");
159    my $im = Image::Scale->new( _f('bug17573-thin.gif') );
160
161    $im->resize_gd_fixed_point( { width => 40 } );
162    $im->save_png($outfile);
163
164    is( _compare( _load($outfile), "bug17573-thin_gd_fixed_point_w40.png" ), 1, "GIF resize_gd_fixed_point from thin image ok" );
165}
166
167diag("giflib version: $gif_version");
168
169END {
170    File::Path::rmtree($tmpdir);
171}
172
173sub _f {
174    return catfile( $FindBin::Bin, 'images', 'gif', shift );
175}
176
177sub _tmp {
178    return catfile( $tmpdir, shift );
179}
180
181sub _load {
182    my $path = shift;
183
184    open my $fh, '<', $path or die "Cannot open $path";
185    binmode $fh;
186    my $data = do { local $/; <$fh> };
187    close $fh;
188
189    return \$data;
190}
191
192sub _compare {
193    my ( $test, $path ) = @_;
194
195    my $ref = _load( catfile( $FindBin::Bin, 'ref', 'gif', $path ) );
196
197    return $$ref eq $$test;
198}
199