more iolayer goodness:
[imager.git] / t / t07iolayer.t
1 #!perl -w
2 use strict;
3 use Test::More tests => 43;
4 use Fcntl ':seek';
5
6 BEGIN { use_ok(Imager => ':all') };
7
8 init_log("testout/t07iolayer.log", 1);
9
10 undef($/);
11 # start by testing io buffer
12
13 my $data="P2\n2 2\n255\n 255 0\n0 255\n";
14 my $IO = Imager::io_new_buffer($data);
15 my $im = Imager::i_readpnm_wiol($IO, -1);
16
17 ok($im, "read from data io");
18
19 open(FH, ">testout/t07.ppm") or die $!;
20 binmode(FH);
21 my $fd = fileno(FH);
22 my $IO2 = Imager::io_new_fd( $fd );
23 Imager::i_writeppm_wiol($im, $IO2);
24 close(FH);
25 undef($im);
26
27 open(FH, "<testimg/penguin-base.ppm");
28 binmode(FH);
29 $data = <FH>;
30 close(FH);
31 my $IO3 = Imager::io_new_buffer($data);
32 #undef($data);
33 $im = Imager::i_readpnm_wiol($IO3, -1);
34
35 ok($im, "read from buffer, for compare");
36 undef $IO3;
37
38 open(FH, "<testimg/penguin-base.ppm") or die $!;
39 binmode(FH);
40 $fd = fileno(FH);
41 my $IO4 = Imager::io_new_fd( $fd );
42 my $im2 = Imager::i_readpnm_wiol($IO4, -1);
43 close(FH);
44 undef($IO4);
45
46 ok($im2, "read from file, for compare");
47
48 is(i_img_diff($im, $im2), 0, "compare images");
49 undef($im2);
50
51 my $IO5 = Imager::io_new_bufchain();
52 Imager::i_writeppm_wiol($im, $IO5);
53 my $data2 = Imager::io_slurp($IO5);
54 undef($IO5);
55
56 ok($data2, "check we got data from bufchain");
57
58 my $IO6 = Imager::io_new_buffer($data2);
59 my $im3 = Imager::i_readpnm_wiol($IO6, -1);
60
61 is(Imager::i_img_diff($im, $im3), 0, "read from buffer");
62
63 my $work = $data;
64 my $pos = 0;
65 sub io_reader {
66   my ($size, $maxread) = @_;
67   my $out = substr($work, $pos, $maxread);
68   $pos += length $out;
69   $out;
70 }
71 sub io_reader2 {
72   my ($size, $maxread) = @_;
73   my $out = substr($work, $pos, $maxread);
74   $pos += length $out;
75   $out;
76 }
77 my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
78 ok($IO7, "making readcb object");
79 my $im4 = Imager::i_readpnm_wiol($IO7, -1);
80 ok($im4, "read from cb");
81 ok(Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
82
83 $pos = 0;
84 $IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
85 ok($IO7, "making short readcb object");
86 my $im5 = Imager::i_readpnm_wiol($IO7, -1);
87 ok($im4, "read from cb2");
88 is(Imager::i_img_diff($im, $im5), 0, "read from cb2 image match");
89
90 sub io_writer {
91   my ($what) = @_;
92   substr($work, $pos, $pos+length $what) = $what;
93   $pos += length $what;
94
95   1;
96 }
97
98 my $did_close;
99 sub io_close {
100   ++$did_close;
101 }
102
103 my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
104 ok($IO8, "making writecb object");
105 $pos = 0;
106 $work = '';
107 ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
108 # I originally compared this to $data, but that doesn't include the
109 # Imager header
110 ok($work eq $data2, "write image match");
111 ok($did_close, "did close");
112
113 # with a short buffer, no closer
114 my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
115 ok($IO9, "making short writecb object");
116 $pos = 0;
117 $work = '';
118 ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
119 ok($work eq $data2, "short write image match");
120
121 {
122   my $buf_data = "Test data";
123   my $io9 = Imager::io_new_buffer($buf_data);
124   is(ref $io9, "Imager::IO", "check class");
125   my $work;
126   is($io9->read($work, 4), 4, "read 4 from buffer object");
127   is($work, "Test", "check data read");
128   is($io9->read($work, 5), 5, "read the rest");
129   is($work, " data", "check data read");
130   is($io9->seek(5, SEEK_SET), 5, "seek");
131   is($io9->read($work, 5), 4, "short read");
132   is($work, "data", "check data read");
133   is($io9->seek(-1, SEEK_CUR), 8, "seek relative");
134   is($io9->seek(-5, SEEK_END), 4, "seek relative to end");
135   is($io9->seek(-10, SEEK_CUR), -1, "seek failure");
136   undef $io9;
137 }
138 {
139   my $io = Imager::io_new_bufchain();
140   is(ref $io, "Imager::IO", "check class");
141   is($io->write("testdata"), 8, "check write");
142   is($io->seek(-8, SEEK_CUR), 0, "seek relative");
143   my $work;
144   is($io->read($work, 8), 8, "check read");
145   is($work, "testdata", "check data read");
146   is($io->seek(-3, SEEK_END), 5, "seek end relative");
147   is($io->read($work, 5), 3, "short read");
148   is($work, "ata", "check read data");
149   is($io->seek(4, SEEK_SET), 4, "absolute seek to write some");
150   is($io->write("testdata"), 8, "write");
151   is($io->seek(0, SEEK_CUR), 12, "check size");
152   $io->close();
153   
154   # grab the data
155   my $data = Imager::io_slurp($io);
156   is($data, "testtestdata", "check we have the right data");
157 }