dist/Storable/t/file_magic.t

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