1#!perl -w 2 3use strict; 4use Test::More; 5use Storable qw(store nstore); 6use Config qw(%Config); 7 8# The @tests array below was create by the following program 9my $dummy = <<'EOT'; 10use Storable; 11use Data::Dump qw(dump); 12 13print "my \@tests = (\n"; 14for my $f (<data_*>) { 15 print " [\n"; 16 print " " . dump(substr(`cat $f`, 0, 32) . "...") , ",\n"; 17 18 my $x = dump(Storable::file_magic($f)); 19 $x =~ s/^/ /gm; 20 print "$x,\n"; 21 22 print " ],\n"; 23} 24print ");\n"; 25EOT 26 27my @tests = ( 28 [ 29 "perl-store\x041234\4\4\4\xD4\xC2\32\b\3\13\0\0\0v\b\xC5\32\b...", 30 { 31 byteorder => 1234, 32 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.1.le32", 33 hdrsize => 18, 34 intsize => 4, 35 longsize => 4, 36 netorder => 0, 37 ptrsize => 4, 38 version => -1, 39 version_nv => -1, 40 }, 41 ], 42 [ 43 "perl-store\0\x041234\4\4\4\x8Co\34\b\3\13\0\0\0v\x94v\34...", 44 { 45 byteorder => 1234, 46 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.le32", 47 hdrsize => 19, 48 intsize => 4, 49 longsize => 4, 50 major => 0, 51 netorder => 0, 52 ptrsize => 4, 53 version => 0, 54 version_nv => 0, 55 }, 56 ], 57 [ 58 "perl-store\1\x8Co\34\b\3\0\0\0\13v\x94v\34\b\1\0\0\4\0\0\0...", 59 { 60 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.neutral", 61 hdrsize => 11, 62 major => 0, 63 netorder => 1, 64 version => 0, 65 version_nv => 0, 66 }, 67 ], 68 [ 69 "pst0\2\x041234\4\4\4\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0\0\0...", 70 { 71 byteorder => 1234, 72 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.le32", 73 hdrsize => 13, 74 intsize => 4, 75 longsize => 4, 76 major => 1, 77 netorder => 0, 78 ptrsize => 4, 79 version => 1, 80 version_nv => 1, 81 }, 82 ], 83 [ 84 "pst0\3\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", 85 { 86 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.neutral", 87 hdrsize => 5, 88 major => 1, 89 netorder => 1, 90 version => 1, 91 version_nv => 1, 92 }, 93 ], 94 [ 95 "pst0\4\0\x041234\4\4\4\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0\0...", 96 { 97 byteorder => 1234, 98 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.le32", 99 hdrsize => 14, 100 intsize => 4, 101 longsize => 4, 102 major => 2, 103 minor => 0, 104 netorder => 0, 105 ptrsize => 4, 106 version => "2.0", 107 version_nv => "2.000", 108 }, 109 ], 110 [ 111 "pst0\5\0\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", 112 { 113 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.neutral", 114 hdrsize => 6, 115 major => 2, 116 minor => 0, 117 netorder => 1, 118 version => "2.0", 119 version_nv => "2.000", 120 }, 121 ], 122 [ 123 "pst0\4\4\x041234\4\4\4\x08\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0...", 124 { 125 byteorder => 1234, 126 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-1.012.le32", 127 hdrsize => 15, 128 intsize => 4, 129 longsize => 4, 130 major => 2, 131 minor => 4, 132 netorder => 0, 133 nvsize => 8, 134 ptrsize => 4, 135 version => "2.4", 136 version_nv => "2.004", 137 }, 138 ], 139 [ 140 "pst0\4\3\x044321\4\4\4\x08\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0...", 141 { 142 byteorder => 4321, 143 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.be32", 144 hdrsize => 15, 145 intsize => 4, 146 longsize => 4, 147 major => 2, 148 minor => 3, 149 netorder => 0, 150 nvsize => 8, 151 ptrsize => 4, 152 version => "2.3", 153 version_nv => "2.003", 154 }, 155 ], 156 [ 157 "pst0\5\3\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", 158 { 159 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.neutral", 160 hdrsize => 6, 161 major => 2, 162 minor => 3, 163 netorder => 1, 164 version => "2.3", 165 version_nv => "2.003", 166 }, 167 ], 168 [ 169 "pst0\4\4\x044321\4\4\4\x08\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0...", 170 { 171 byteorder => 4321, 172 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.be32", 173 hdrsize => 15, 174 intsize => 4, 175 longsize => 4, 176 major => 2, 177 minor => 4, 178 netorder => 0, 179 nvsize => 8, 180 ptrsize => 4, 181 version => "2.4", 182 version_nv => "2.004", 183 }, 184 ], 185 [ 186 "pst0\5\4\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", 187 { 188 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.neutral", 189 hdrsize => 6, 190 major => 2, 191 minor => 4, 192 netorder => 1, 193 version => "2.4", 194 version_nv => "2.004", 195 }, 196 ], 197 [ 198 "pst0\4\6\x044321\4\4\4\x08\3\0\0\0\13\n\n4294967296...", 199 { 200 byteorder => 4321, 201 file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.be32", 202 hdrsize => 15, 203 intsize => 4, 204 longsize => 4, 205 major => 2, 206 minor => 6, 207 netorder => 0, 208 nvsize => 8, 209 ptrsize => 4, 210 version => "2.6", 211 version_nv => "2.006", 212 }, 213 ], 214 [ 215 "pst0\5\6\3\0\0\0\13\n\n4294967296\0\0\0\bfour_...", 216 { 217 file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.neutral", 218 hdrsize => 6, 219 major => 2, 220 minor => 6, 221 netorder => 1, 222 version => "2.6", 223 version_nv => "2.006", 224 }, 225 ], 226 [ 227 "pst0\4\6\x044321\4\4\4\x08\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nem...", 228 { 229 byteorder => 4321, 230 file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.be32", 231 hdrsize => 15, 232 intsize => 4, 233 longsize => 4, 234 major => 2, 235 minor => 6, 236 netorder => 0, 237 nvsize => 8, 238 ptrsize => 4, 239 version => "2.6", 240 version_nv => "2.006", 241 }, 242 ], 243 [ 244 "pst0\5\6\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", 245 { 246 file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.neutral", 247 hdrsize => 6, 248 major => 2, 249 minor => 6, 250 netorder => 1, 251 version => "2.6", 252 version_nv => "2.006", 253 }, 254 ], 255 [ 256 "pst0\4\6\x0812345678\4\4\4\x08\3\13\0\0\0\4\3\0\0\0\0\n\0...", 257 { 258 byteorder => 12_345_678, 259 file => "data_perl-5.008004_i86pc-solaris-64int_Storable-2.12.le64", 260 hdrsize => 19, 261 intsize => 4, 262 longsize => 4, 263 major => 2, 264 minor => 6, 265 netorder => 0, 266 nvsize => 8, 267 ptrsize => 4, 268 version => "2.6", 269 version_nv => "2.006", 270 }, 271 ], 272 [ 273 "pst0\4\6\x041234\4\4\4\x08\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", 274 { 275 byteorder => 1234, 276 file => "data_perl-5.008006_i686-linux-thread-multi_Storable-2.13.le32", 277 hdrsize => 15, 278 intsize => 4, 279 longsize => 4, 280 major => 2, 281 minor => 6, 282 netorder => 0, 283 nvsize => 8, 284 ptrsize => 4, 285 version => "2.6", 286 version_nv => "2.006", 287 }, 288 ], 289 [ 290 "pst0\4\6\x0887654321\4\x08\x08\x08\3\0\0\0\13\4\3\0\0\0\0\0\0...", 291 { 292 byteorder => 87_654_321, 293 file => "data_perl-5.008007_IA64.ARCHREV_0-thread-multi-LP64_Storable-2.13.be64", 294 hdrsize => 19, 295 intsize => 4, 296 longsize => 8, 297 major => 2, 298 minor => 6, 299 netorder => 0, 300 nvsize => 8, 301 ptrsize => 8, 302 version => "2.6", 303 version_nv => "2.006", 304 }, 305 ], 306 [ 307 "pst0\4\x07\x0812345678\4\x08\x08\x08\3\13\0\0\0\4\3\0\0\0\0\n\0...", 308 { 309 byteorder => 12_345_678, 310 file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.le64", 311 hdrsize => 19, 312 intsize => 4, 313 longsize => 8, 314 major => 2, 315 minor => 7, 316 netorder => 0, 317 nvsize => 8, 318 ptrsize => 8, 319 version => "2.7", 320 version_nv => "2.007", 321 }, 322 ], 323 [ 324 "pst0\5\x07\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", 325 { 326 file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.neutral", 327 hdrsize => 6, 328 major => 2, 329 minor => 7, 330 netorder => 1, 331 version => "2.7", 332 version_nv => "2.007", 333 }, 334 ], 335 [ 336 "pst0\4\5\x041234\4\4\4\x08\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", 337 { 338 byteorder => 1234, 339 file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.le32", 340 hdrsize => 15, 341 intsize => 4, 342 longsize => 4, 343 major => 2, 344 minor => 5, 345 netorder => 0, 346 nvsize => 8, 347 ptrsize => 4, 348 version => "2.5", 349 version_nv => "2.005", 350 }, 351 ], 352 [ 353 "pst0\5\5\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", 354 { 355 file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.neutral", 356 hdrsize => 6, 357 major => 2, 358 minor => 5, 359 netorder => 1, 360 version => "2.5", 361 version_nv => "2.005", 362 }, 363 ], 364 [ 365 "pst0\4\x07\x041234\4\4\4\x08\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", 366 { 367 byteorder => 1234, 368 file => "data_perl-5.009003_i686-linux_Storable-2.15.le32", 369 hdrsize => 15, 370 intsize => 4, 371 longsize => 4, 372 major => 2, 373 minor => 7, 374 netorder => 0, 375 nvsize => 8, 376 ptrsize => 4, 377 version => "2.7", 378 version_nv => "2.007", 379 }, 380 ], 381); 382 383plan tests => 31 + 2 * @tests; 384 385my $file = "xx-$$.pst"; 386 387is(eval { Storable::file_magic($file) }, undef, "empty file give undef"); 388like($@, qq{/^Can't open '\Q$file\E':/}, "...and croaks"); 389is(Storable::file_magic(__FILE__), undef, "not an image"); 390 391store({}, $file); 392{ 393 my $info = Storable::file_magic($file); 394 unlink($file); 395 ok($info, "got info"); 396 is($info->{file}, $file, "file set"); 397 is($info->{hdrsize}, 11 + length($Config{byteorder}), "hdrsize"); 398 like($info->{version}, q{/^2\.\d+$/}, "sane version"); 399 is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match"); 400 is($info->{major}, 2, "sane major"); 401 ok($info->{minor}, "have minor"); 402 ok($info->{minor} >= Storable::BIN_WRITE_MINOR, "large enough minor"); 403 404 ok(!$info->{netorder}, "no netorder"); 405 406 my %attrs = ( 407 nvsize => 5.006, 408 ptrsize => 5.005, 409 map {$_ => 5.004} qw(byteorder intsize longsize) 410 ); 411 for my $attr (keys %attrs) { 412 SKIP: { 413 skip "attribute $attr not available on this version of Perl", 1 if $attrs{$attr} > $]; 414 is($info->{$attr}, $Config{$attr}, "$attr match Config"); 415 } 416 } 417} 418 419nstore({}, $file); 420{ 421 my $info = Storable::file_magic($file); 422 unlink($file); 423 ok($info, "got info"); 424 is($info->{file}, $file, "file set"); 425 is($info->{hdrsize}, 6, "hdrsize"); 426 like($info->{version}, q{/^2\.\d+$/}, "sane version"); 427 is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match"); 428 is($info->{major}, 2, "sane major"); 429 ok($info->{minor}, "have minor"); 430 ok($info->{minor} >= Storable::BIN_WRITE_MINOR, "large enough minor"); 431 432 ok($info->{netorder}, "no netorder"); 433 for (qw(byteorder intsize longsize ptrsize nvsize)) { 434 ok(!exists $info->{$_}, "no $_"); 435 } 436} 437 438for my $test (@tests) { 439 my($data, $expected) = @$test; 440 open(FH, ">$file") || die "Can't create $file: $!"; 441 binmode(FH); 442 print FH $data; 443 close(FH) || die "Can't write $file: $!"; 444 445 my $name = $expected->{file}; 446 $expected->{file} = $file; 447 448 my $info = Storable::file_magic($file); 449 unlink($file); 450 451 is_deeply($info, $expected, "file_magic $name"); 452 453 $expected->{file} = 1; 454 is_deeply(Storable::read_magic($data), $expected, "read magic $name"); 455} 456