]> git.imager.perl.org - imager.git/commitdiff
read_multi() now falls back to calling read() and write_multi() now
authorTony Cook <tony@develop=help.com>
Wed, 6 Sep 2006 11:35:38 +0000 (11:35 +0000)
committerTony Cook <tony@develop=help.com>
Wed, 6 Sep 2006 11:35:38 +0000 (11:35 +0000)
falls back to calling write() for a single image.

Imager.pm
t/t102png.t

index 0c10d9ade1292b944d5c946b838c3271c90efed8..92135e5eb6e101d4075f2411775ff1f67a3879db 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -1123,9 +1123,9 @@ sub settag {
 sub _get_reader_io {
   my ($self, $input) = @_;
 
-       if ($input->{io}) {
-               return $input->{io}, undef;
-       }
+  if ($input->{io}) {
+    return $input->{io}, undef;
+  }
   elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }
@@ -1174,7 +1174,10 @@ sub _get_reader_io {
 sub _get_writer_io {
   my ($self, $input, $type) = @_;
 
-  if ($input->{fd}) {
+  if ($input->{io}) {
+    return $input->{io};
+  }
+  elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }
   elsif ($input->{fh}) {
@@ -1790,8 +1793,15 @@ sub write_multi {
       }
     }
     else {
-      $ERRSTR = "Sorry, write_multi doesn't support $type yet";
-      return 0;
+      if (@images == 1) {
+       unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
+         return 1;
+       }
+      }
+      else {
+       $ERRSTR = "Sorry, write_multi doesn't support $type yet";
+       return 0;
+      }
     }
   }
 
@@ -1859,6 +1869,12 @@ sub read_multi {
       return;
     }
   }
+  else {
+    my $img = Imager->new;
+    if ($img->read(%opts, io => $IO, type => $type)) {
+      return ( $img );
+    }
+  }
 
   $ERRSTR = "Cannot read multiple images from $type files";
   return;
index 0401e155f264d25657e4180ea288040cc73ec480..2f2d99aba344f45e55297799f366e7a2ca2567e4 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use lib 't';
-use Test::More tests => 28;
+use Test::More tests => 32;
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
@@ -42,7 +42,7 @@ if (!i_has_format("png")) {
     $im = Imager->new(xsize=>2, ysize=>2);
     ok(!$im->write(file=>"testout/nopng.png"), "should fail to write png");
     is($im->errstr, 'format not supported', "check no png message");
-    skip("no png support", 23);
+    skip("no png support", 27);
   }
 } else {
   Imager::i_tags_add($img, "i_xres", 0, "300", 0);
@@ -152,4 +152,19 @@ EOS
     Imager->set_file_limits(reset=>1);
   }
 
+  { # check if the read_multi fallback works
+    my @imgs = Imager->read_multi(file => 'testout/t102.png');
+    is(@imgs, 1, "check the image was loaded");
+    is(i_img_diff($img, $imgs[0]), 0, "check image matches");
+
+    # check the write_multi fallback
+    ok(Imager->write_multi({ file => 'testout/t102m.png', type => 'png' }, 
+                          @imgs),
+       'test write_multi() callback');
+
+    # check that we fail if we actually write 2
+    ok(!Imager->write_multi({ file => 'testout/t102m.png', type => 'png' }, 
+                          @imgs, @imgs),
+       'test write_multi() callback failure');
+  }
 }