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});
}
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}) {
}
}
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;
+ }
}
}
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;
#!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'
$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);
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');
+ }
}