1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test qw(noX11); 6 7my @codecs; 8 9@codecs = grep { 10 $_-> {canSaveStream} and $_-> {canLoadStream} 11} @{Prima::Image-> codecs}; 12 13# testing if can write file 14my $fileok = 0; 15if ( open F, "> ./test.test" ) { 16 if ( print F ('0'x10240)) { 17 $fileok = 1 if close F; 18 } else { 19 close F; 20 } 21 unlink "./test.test"; 22} 23unless ( $fileok) { 24 print "1..1 load/save to streams"; 25 skip("skipping load/save to streams"); 26 return 1; 27} 28 29my $i = Prima::Image-> create( 30 width => 16, 31 height => 16, 32 type => im::bpp1, 33 palette => [0,0,0,255,0,0], 34 data => 35 "\x00\x00\x00\x00\x7f\xfe\x00\x00\@\x02\x00\x00_\xfa\x00\x00P\x0a\x00\x00". 36 "W\xea\x00\x00T\*\x00\x00U\xaa\x00\x00U\xaa\x00\x00T\*\x00\x00". 37 "W\xea\x00\x00P\x0a\x00\x00_\xfa\x00\x00\@\x02\x00\x00\x7f\xfe\x00\x00". 38 "\x00\x00\x00\x00" 39); 40 41for ( @codecs) { 42 SKIP : { 43 my $ci = $_; 44 my $name = "./test.test." . $ci-> {fileExtensions}->[0]; 45 46 my $xi = $i-> dup; 47 unless( open F, ">", $name) { 48 warn("Cannot open $name:$!"); 49 fail("load ".$ci->{fileShortType}); 50 skip "skipping load ".$ci->{fileShortType}, 2; 51 } 52 binmode F; 53 unless ( $xi-> save( \*F, codecID => $ci-> {codecID})) { 54 warn("Cannot save: $@"); 55 fail("save ".$ci->{fileShortType}); 56 skip "skipping save ".$ci->{fileShortType}, 2; 57 close F; 58 unlink $name; 59 } 60 close F; 61 pass("save ".$ci->{fileShortType}); 62 63 unless ( open F, "<", $name) { 64 warn("Cannot open $name:$! / $ci->{versionMajor}.$ci->{versionMinor}"); 65 fail($ci->{fileShortType}); 66 unlink $name; 67 skip "load ".$ci->{fileShortType}, 1; 68 } 69 binmode F; 70 71 my $xl = Prima::Image-> load( \*F, loadExtras => 1); 72 close F; 73 unlink $name; 74 unless ( $xl) { 75 warn("Cannot load:$@"); 76 fail($ci->{fileShortType}); 77 skip "load ".$ci->{fileShortType}, 1; 78 } 79 80 pass("load ".$ci->{fileShortType}); 81 }; 82} 83 84done_testing(); 85