From e7ff1cf7475e8399c1955fa05abd8c0cf3758efe Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop=help.com>
Date: Wed, 6 Sep 2006 11:35:38 +0000
Subject: [PATCH] read_multi() now falls back to calling read() and
 write_multi() now falls back to calling write() for a single image.

---
 Imager.pm   | 28 ++++++++++++++++++++++------
 t/t102png.t | 19 +++++++++++++++++--
 2 files changed, 39 insertions(+), 8 deletions(-)

diff --git a/Imager.pm b/Imager.pm
index 0c10d9ad..92135e5e 100644
--- 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;
diff --git a/t/t102png.t b/t/t102png.t
index 0401e155..2f2d99ab 100644
--- a/t/t102png.t
+++ b/t/t102png.t
@@ -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');
+  }
 }
-- 
2.39.5