1#!perl -w
2
3BEGIN {
4    unshift @INC, 't/compat' if $] < 5.006002;
5};
6
7use strict;
8use Test::More;
9use Storable qw(store nstore);
10use Config qw(%Config);
11
12# The @tests array below was create by the following program
13my $dummy = <<'EOT';
14use Storable;
15use Data::Dump qw(dump);
16
17print "my \@tests = (\n";
18for 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}
28print ");\n";
29EOT
30
31my @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
387plan tests => 31 + 2 * @tests;
388
389my $file = "xx-$$.pst";
390
391is(eval { Storable::file_magic($file) }, undef, "empty file give undef");
392like($@, qq{/^Can't open '\Q$file\E':/}, "...and croaks");
393is(Storable::file_magic(__FILE__), undef, "not an image");
394
395store({}, $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
423nstore({}, $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
442for 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}
460