t/t1000files.t

   1 #!perl -w
   2
   3 # This file is for testing file functionality that is independent of
   4 # the file format
   5
   6 use strict;
   7 use Test::More tests => 32;
   8 use Imager;
   9
  10 Imager::init_log("testout/t1000files.log", 1);
  11
  12 SKIP:
  13 {
  14   # Initally I tried to write this test using open to redirect files,
  15   # but there was a buffering problem that made it so the data wasn't
  16   # being written to the output file.  This external perl call avoids
  17   # that problem
  18
  19   my $test_script = 'testout/t1000files_probe.pl';
  20
  21   # build a temp test script to use
  22   ok(open(SCRIPT, "> $test_script"), "open test script")
  23     or skip("no test script $test_script: $!", 2);
  24   print SCRIPT <<'PERL';
  25 #!perl
  26 use Imager;
  27 use strict;
  28 my $file = shift or die "No file supplied";
  29 open FH, "< $file" or die "Cannot open file: $!";
  30 binmode FH;
  31 my $io = Imager::io_new_fd(fileno(FH));
  32 Imager::i_test_format_probe($io, -1);
  33 PERL
  34   close SCRIPT;
  35   my $perl = $^X;
  36   $perl = qq/"$perl"/ if $perl =~ / /;
  37
  38   print "# script: $test_script\n";
  39   my $cmd = "$perl -Mblib $test_script t/t1000files.t";
  40   print "# command: $cmd\n";
  41
  42   my $out = `$cmd`;
  43   is($?, 0, "command successful");
  44   is($out, '', "output should be empty");
  45 }
  46
  47 # test the file limit functions
  48 # by default the limits are zero (unlimited)
  49 print "# image file limits\n";
  50 is_deeply([ Imager->get_file_limits() ], [0, 0, 0],
  51           "check defaults");
  52 ok(Imager->set_file_limits(width=>100), "set only width");
  53 is_deeply([ Imager->get_file_limits() ], [100, 0, 0 ],
  54           "check width set");
  55 ok(Imager->set_file_limits(height=>150, bytes=>10000),
  56    "set height and bytes");
  57 is_deeply([ Imager->get_file_limits() ], [ 100, 150, 10000 ],
  58           "check all values now set");
  59 ok(Imager->set_file_limits(reset=>1, height => 99),
  60    "set height and reset");
  61 is_deeply([ Imager->get_file_limits() ], [ 0, 99, 0 ],
  62           "check only height is set");
  63 ok(Imager->set_file_limits(reset=>1),
  64    "just reset");
  65 is_deeply([ Imager->get_file_limits() ], [ 0, 0, 0 ],
  66           "check all are reset");
  67
  68 # check file type probe
  69 probe_ok("49492A41", undef, "not quite tiff");
  70 probe_ok("4D4D0041", undef, "not quite tiff");
  71 probe_ok("49492A00", "tiff", "tiff intel");
  72 probe_ok("4D4D002A", "tiff", "tiff motorola");
  73 probe_ok("474946383961", "gif", "gif 89");
  74 probe_ok("474946383761", "gif", "gif 87");
  75 probe_ok(<<TGA, "tga", "TGA");
  76 00 00 0A 00 00 00 00 00 00 00 00 00 96 00 96 00
  77 18 20 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
  78 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
  79 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
  80 TGA
  81
  82 probe_ok(<<ICO, "ico", "Windows Icon");
  83 00 00 01 00 02 00 20 20 10 00 00 00 00 00 E8 02
  84 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
  85 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
  86 ICO
  87
  88 probe_ok(<<ICO, "cur", "Windows Cursor");
  89 00 00 02 00 02 00 20 20 10 00 00 00 00 00 E8 02
  90 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
  91 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
  92 ICO
  93
  94 probe_ok(<<RGB, "rgb", "SGI RGB");
  95 01 DA 01 01 00 03 00 96 00 96 00 03 00 00 00 00
  96 00 00 00 FF 00 00 00 00 6E 6F 20 6E 61 6D 65 00
  97 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  98 RGB
  99
 100 probe_ok(<<ILBM, "ilbm", "ILBM");
 101 46 4F 52 4D 00 00 60 7A 49 4C 42 4D 42 4D 48 44
 102 00 00 00 14 00 96 00 96 00 00 00 00 18 00 01 80
 103 00 00 0A 0A 00 96 00 96 42 4F 44 59 00 00 60 51
 104 ILBM
 105
 106 probe_ok(<<XPM, "xpm", "XPM");
 107 2F 2A 20 58 50 4D 20 2A 2F 0A 73 74 61 74 69 63
 108 20 63 68 61 72 20 2A 6E 6F 6E 61 6D 65 5B 5D 20
 109 3D 20 7B 0A 2F 2A 20 77 69 64 74 68 20 68 65 69
 110 XPM
 111
 112 probe_ok(<<PCX, "pcx", 'PCX');
 113 0A 05 01 08 00 00 00 00 95 00 95 00 96 00 96 00
 114 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
 115 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
 116 PCX
 117
 118 probe_ok(<<FITS, "fits", "FITS");
 119 53 49 4D 50 4C 45 20 20 3D 20 20 20 20 20 20 20
 120 20 20 20 20 20 20 20 20 20 20 20 20 20 54 20 20
 121 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
 122 FITS
 123
 124 probe_ok(<<PSD, "psd", "Photoshop");
 125 38 42 50 53 00 01 00 00 00 00 00 00 00 06 00 00
 126 00 3C 00 00 00 96 00 08 00 03 00 00 00 00 00 00
 127 0B E6 38 42 49 4D 03 ED 00 00 00 00 00 10 00 90
 128 PSD
 129
 130 probe_ok(<<EPS, "eps", "Encapsulated Postscript");
 131 25 21 50 53 2D 41 64 6F 62 65 2D 32 2E 30 20 45
 132 50 53 46 2D 32 2E 30 0A 25 25 43 72 65 61 74 6F
 133 72 3A 20 70 6E 6D 74 6F 70 73 0A 25 25 54 69 74
 134 EPS
 135
 136 probe_ok(<<UTAH, "utah", "Utah RLE");
 137 52 CC 00 00 00 00 0A 00 0A 00 0A 03 08 00 08 00
 138 2F 00 48 49 53 54 4F 52 59 3D 70 6E 6D 74 6F 72
 139 6C 65 20 6F 6E 20 54 68 75 20 4D 61 79 20 31 31
 140 20 31 36 3A 33 35 3A 34 33 20 32 30 30 36 0A 09
 141 UTAH
 142
 143 probe_ok(<<XWD, "xwd", "X Window Dump");
 144 00 00 00 69 00 00 00 07 00 00 00 02 00 00 00 18
 145 00 00 01 E4 00 00 01 3C 00 00 00 00 00 00 00 00
 146 00 00 00 20 00 00 00 00 00 00 00 20 00 00 00 20
 147 00 00 07 90 00 00 00 04 00 FF 00 00 00 00 FF 00
 148 XWD
 149
 150 probe_ok(<<GZIP, "gzip", "gzip compressed");
 151 1F 8B 08 08 C2 81 BD 44 02 03 49 6D 61 67 65 72
 152 2D 30 2E 35 31 5F 30 33 2E 74 61 72 00 EC 5B 09
 153 40 53 C7 BA 9E 24 AC 01 D9 44 04 44 08 8B B2 8A
 154 C9 C9 42 92 56 41 50 20 A0 02 41 41 01 17 48 80
 155 GZIP
 156
 157 probe_ok(<<BZIP2, "bzip2", "bzip2 compressed");
 158 42 5A 68 39 31 41 59 26 53 59 0F D8 8C 09 00 03
 159 28 FF FF FF FF FB 7F FB 77 FF EF BF 6B 7F BE FF
 160 FF DF EE C8 0F FF F3 FF FF FF FC FF FB B1 FF FB
 161 F4 07 DF D0 03 B8 03 60 31 82 05 2A 6A 06 83 20
 162 BZIP2
 163
 164 sub probe_ok {
 165   my ($packed, $exp_type, $name) = @_;
 166
 167   my $builder = Test::Builder->new;
 168   $packed =~ tr/ \r\n//d; # remove whitespace used for layout
 169   my $data = pack("H*", $packed);
 170
 171   my $io = Imager::io_new_buffer($data);
 172   my $result = Imager::i_test_format_probe($io, -1);
 173
 174   return $builder->is_eq($result, $exp_type, $name)
 175 }