1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir 't' if -d 't'; 4 @INC = ("../lib", "lib/compress"); 5 } 6} 7 8use lib qw(t t/compress); 9use strict; 10use warnings; 11use bytes; 12 13use Test::More ; 14use CompTestUtils; 15 16BEGIN { 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 35sub 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); 73 $mtime = (stat($file1))[9]; 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); 85 $mtime = (stat($file1))[9]; 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 135