Commit | Line | Data |
1a6a8453 |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { |
3 | chdir 't' if -d 't'; |
4 | @INC = ("../lib", "lib/compress"); |
5 | } |
6 | } |
7 | |
8 | use lib 't'; |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use ZlibTestUtils; |
15 | |
16 | BEGIN { |
17 | plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" ) |
18 | if $] < 5.005 ; |
19 | |
20 | |
21 | # use Test::NoWarnings, if available |
22 | my $extra = 0 ; |
23 | $extra = 1 |
24 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
25 | |
26 | plan tests => 70 + $extra ; |
27 | |
28 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
29 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; |
30 | |
31 | |
32 | } |
33 | |
34 | |
35 | sub gzipGetHeader |
36 | { |
37 | my $in = shift; |
38 | my $content = shift ; |
39 | my %opts = @_ ; |
40 | |
41 | my $out ; |
42 | my $got ; |
43 | |
44 | ok IO::Compress::Gzip::gzip($in, \$out, %opts), " gzip ok" ; |
45 | ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" |
46 | or diag $GunzipError ; |
47 | is $got, $content, " got expected content" ; |
48 | |
49 | my $gunz = new IO::Uncompress::Gunzip \$out, Strict => 0 |
50 | or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; |
51 | ok $gunz, " Created IO::Uncompress::Gunzip object"; |
52 | my $hdr = $gunz->getHeaderInfo(); |
53 | ok $hdr, " got Header info"; |
54 | my $uncomp ; |
55 | ok $gunz->read($uncomp), " read ok" ; |
56 | is $uncomp, $content, " got expected content"; |
57 | ok $gunz->close, " closed ok" ; |
58 | |
59 | return $hdr ; |
60 | |
61 | } |
62 | |
63 | { |
64 | title "Check gzip header default NAME & MTIME settings" ; |
65 | |
66 | my $lex = new LexFile my $file1; |
67 | |
68 | my $content = "hello "; |
69 | my $hdr ; |
70 | my $mtime ; |
71 | |
72 | writeFile($file1, $content); |
204a02c3 |
73 | $mtime = (stat($file1))[9]; |
1a6a8453 |
74 | # make sure that the gzip file isn't created in the same |
75 | # second as the input file |
76 | sleep 3 ; |
77 | $hdr = gzipGetHeader($file1, $content); |
78 | |
79 | is $hdr->{Name}, $file1, " Name is '$file1'"; |
80 | is $hdr->{Time}, $mtime, " Time is ok"; |
81 | |
82 | title "Override Name" ; |
83 | |
84 | writeFile($file1, $content); |
204a02c3 |
85 | $mtime = (stat($file1))[9]; |
1a6a8453 |
86 | sleep 3 ; |
87 | $hdr = gzipGetHeader($file1, $content, Name => "abcde"); |
88 | |
89 | is $hdr->{Name}, "abcde", " Name is 'abcde'" ; |
90 | is $hdr->{Time}, $mtime, " Time is ok"; |
91 | |
92 | title "Override Time" ; |
93 | |
94 | writeFile($file1, $content); |
95 | $hdr = gzipGetHeader($file1, $content, Time => 1234); |
96 | |
97 | is $hdr->{Name}, $file1, " Name is '$file1'" ; |
98 | is $hdr->{Time}, 1234, " Time is 1234"; |
99 | |
100 | title "Override Name and Time" ; |
101 | |
102 | writeFile($file1, $content); |
103 | $hdr = gzipGetHeader($file1, $content, Time => 4321, Name => "abcde"); |
104 | |
105 | is $hdr->{Name}, "abcde", " Name is 'abcde'" ; |
106 | is $hdr->{Time}, 4321, " Time is 4321"; |
107 | |
108 | title "Filehandle doesn't have default Name or Time" ; |
109 | my $fh = new IO::File "< $file1" |
110 | or diag "Cannot open '$file1': $!\n" ; |
111 | sleep 3 ; |
112 | my $before = time ; |
113 | $hdr = gzipGetHeader($fh, $content); |
114 | my $after = time ; |
115 | |
116 | ok ! defined $hdr->{Name}, " Name is undef"; |
117 | cmp_ok $hdr->{Time}, '>=', $before, " Time is ok"; |
118 | cmp_ok $hdr->{Time}, '<=', $after, " Time is ok"; |
119 | |
120 | $fh->close; |
121 | |
122 | title "Buffer doesn't have default Name or Time" ; |
123 | my $buffer = $content; |
124 | $before = time ; |
125 | $hdr = gzipGetHeader(\$buffer, $content); |
126 | $after = time ; |
127 | |
128 | ok ! defined $hdr->{Name}, " Name is undef"; |
129 | cmp_ok $hdr->{Time}, '>=', $before, " Time is ok"; |
130 | cmp_ok $hdr->{Time}, '<=', $after, " Time is ok"; |
131 | } |
132 | |
133 | # TODO add more error cases |
134 | |