t/t07iolayer.t

   1 BEGIN { $|=1; print "1..20\n"; }
   2 END { print "not ok 1\n" unless $loaded; };
   3 use Imager qw(:all);
   4 ++$loaded;
   5 print "ok 1\n";
   6 init_log("testout/t07iolayer.log", 1);
   7
   8
   9 undef($/);
  10 # start by testing io buffer
  11
  12 $data="P2\n2 2\n255\n 255 0\n0 255\n";
  13 $IO = Imager::io_new_buffer($data);
  14 $im = Imager::i_readpnm_wiol($IO, -1);
  15
  16 print "ok 2\n";
  17
  18
  19 open(FH, ">testout/t07.ppm") or die $!;
  20 binmode(FH);
  21 $fd = fileno(FH);
  22 $IO2 = Imager::io_new_fd( $fd );
  23 Imager::i_writeppm_wiol($im, $IO2);
  24 close(FH);
  25 undef($im);
  26
  27
  28
  29 open(FH, "<testimg/penguin-base.ppm");
  30 binmode(FH);
  31 $data = <FH>;
  32 close(FH);
  33 $IO3 = Imager::io_new_buffer($data);
  34 #undef($data);
  35 $im = Imager::i_readpnm_wiol($IO3, -1);
  36
  37 print "ok 3\n";
  38 undef $IO3;
  39
  40 open(FH, "<testimg/penguin-base.ppm") or die $!;
  41 binmode(FH);
  42 $fd = fileno(FH);
  43 $IO4 = Imager::io_new_fd( $fd );
  44 $im2 = Imager::i_readpnm_wiol($IO4, -1);
  45 close(FH);
  46 undef($IO4);
  47
  48 print "ok 4\n";
  49
  50 Imager::i_img_diff($im, $im2) ? print "not ok 5\n" : print "ok 5\n";
  51 undef($im2);
  52
  53
  54 $IO5 = Imager::io_new_bufchain();
  55 Imager::i_writeppm_wiol($im, $IO5);
  56 $data2 = Imager::io_slurp($IO5);
  57 undef($IO5);
  58
  59 print "ok 6\n";
  60
  61 $IO6 = Imager::io_new_buffer($data2);
  62 $im3 = Imager::i_readpnm_wiol($IO6, -1);
  63
  64 ok(7, Imager::i_img_diff($im, $im3) == 0, "read from buffer");
  65
  66 my $work = $data;
  67 my $pos = 0;
  68 sub io_reader {
  69   my ($size, $maxread) = @_;
  70   my $out = substr($work, $pos, $maxread);
  71   $pos += length $out;
  72   $out;
  73 }
  74 sub io_reader2 {
  75   my ($size, $maxread) = @_;
  76   my $out = substr($work, $pos, $maxread);
  77   $pos += length $out;
  78   $out;
  79 }
  80 my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
  81 ok(8, $IO7, "making readcb object");
  82 my $im4 = Imager::i_readpnm_wiol($IO7, -1);
  83 ok(9, $im4, "read from cb");
  84 ok(10, Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
  85
  86 $pos = 0;
  87 $IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
  88 ok(11, $IO7, "making short readcb object");
  89 my $im5 = Imager::i_readpnm_wiol($IO7, -1);
  90 ok(12, $im4, "read from cb2");
  91 ok(13, Imager::i_img_diff($im, $im5) == 0, "read from cb2 image match");
  92
  93 sub io_writer {
  94   my ($what) = @_;
  95   substr($work, $pos, $pos+length $what) = $what;
  96   $pos += length $what;
  97
  98   1;
  99 }
 100
 101 my $did_close;
 102 sub io_close {
 103   ++$did_close;
 104 }
 105
 106 my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
 107 ok(14, $IO8, "making writecb object");
 108 $pos = 0;
 109 $work = '';
 110 ok(15, Imager::i_writeppm_wiol($im, $IO8), "write to cb");
 111 # I originally compared this to $data, but that doesn't include the
 112 # Imager header
 113 ok(16, $work eq $data2, "write image match");
 114 ok(17, $did_close, "did close");
 115
 116 # with a short buffer, no closer
 117 my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
 118 ok(18, $IO9, "making short writecb object");
 119 $pos = 0;
 120 $work = '';
 121 ok(19, Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
 122 ok(20, $work eq $data2, "short write image match");
 123
 124 sub ok {
 125   my ($num, $ok, $what) = @_;
 126
 127   if ($ok) {
 128     print "ok $num # $what\n";
 129   }
 130   else {
 131     print "not ok $num # $what\n";
 132   }
 133   $ok;
 134 }