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