1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#!/usr/bin/perl -w
use IO::File;
use Image::Size qw(:all);
use Test::More tests => 17;
# We now only test the CWS branch if the user already has Compress::Zlib
# available. We no longer require it for installation.
eval 'require Compress::Zlib;';
$do_cws_test = $@ ? 0 : 1;
($dir = $0) =~ s/\w+\.t$//o;
#
# Phase one: basic types tested on files.
#
($x, $y) = imgsize("${dir}test.gif");
ok(($x == 60 && $y == 40), 'Basic GIF format test');
$html = html_imgsize("${dir}letter_T.jpg");
ok(($html =~ /width="52"\s+height="54"/oi),
'Test html_imgsize and basic JPG format');
@attrs = attr_imgsize("${dir}xterm.xpm");
ok(($attrs[1] == 64 && $attrs[3] == 38),
'Test attr_imgsize and basic XPM format');
($x, $y) = imgsize("${dir}spacer50.xbm");
ok(($x == 50 && $y == 10), 'Basic XBM format test');
($x, $y, $err) = imgsize("some non-existant file");
ok(($err =~ /can\'t open/oi), 'Test non-existent file error catching');
# The Pak-38 is actually a valid GIF, but this should work:
($x, $y) = imgsize("${dir}pak38.jpg");
ok(($x == 333 && $y == 194), 'Test format/file-extension mis-match');
# Test PNG image supplied by Tom Metro:
($x, $y) = imgsize("${dir}pass-1_s.png");
ok(($x == 90 && $y == 60), 'Basic PNG format test');
# Test PPM image code supplied by Carsten Dominik:
($x, $y, $id) = imgsize("${dir}letter_N.ppm");
ok(($x == 66 && $y == 57 && $id eq 'PPM'), 'Basic PPM format test');
# Test TIFF image code supplied by Cloyce Spradling
($x, $y, $id) = imgsize("${dir}lexjdic.tif");
ok(($x == 35 && $y == 32 && $id eq 'TIF'), 'Basic TIFF format test (1)');
($x, $y, $id) = imgsize("${dir}bexjdic.tif");
ok(($x == 35 && $y == 32 && $id eq 'TIF'), 'Basic TIFF format test (2)');
# Test BMP code from Aldo Calpini
($x, $y, $id) = imgsize("${dir}xterm.bmp");
ok(($x == 64 && $y == 38 && $id eq 'BMP'), 'Basic BMP format test');
# Test SWF code from Dmitry Dorofeev <dima@yasp.com>
($x, $y, $id) = imgsize("${dir}yasp.swf");
ok(($x == 85 && $y == 36 && $id eq 'SWF'), 'Basic SWF format test');
SKIP: {
skip 'Compress::Zlib not installed', 1 unless $do_cws_test;
# Test CWS patch from mrj@mrj.spb.ru
($x, $y, $id) = imgsize("${dir}8.swf");
ok(($x == 280 && $y == 140 && $id eq 'CWS'), 'Basic CWS format test');
}
# Test the PSD code (orig. contributer unknown)
($x, $y, $id) = imgsize("${dir}468x60.psd");
ok(($x == 468 && $y == 60 && $id eq 'PSD'), 'Basic PSD format test');
#
# Phase two: tests on in-memory strings.
#
$fh = new IO::File "< ${dir}test.gif";
$data = '';
read $fh, $data, (stat "${dir}test.gif")[7];
$fh->close;
($x, $y, $id) = imgsize(\$data);
ok(($x == 60 && $y == 40 && $id eq 'GIF'), 'Test in-memory image data');
#
# Phase three: tests on open IO::File objects.
#
$fh = new IO::File "< ${dir}test.gif";
($x, $y, $id) = imgsize($fh);
ok(($x == 60 && $y == 40 && $id eq 'GIF'), 'Test open IO::File object');
# Reset to head
$fh->seek(0, 0);
# Move somewhere
$fh->seek(128, 0);
# Do it again. This time when we check results, $fh->tell should be 128
($x, $y, $id) = imgsize($fh);
ok(($x == 60 && $y == 40 && $id eq 'GIF' && ($fh->tell == 128)),
'Test that it leaves open IO::File object in the same position');
$fh->close;
exit;
|
