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 16my $GZIP ; 17 18 19sub ExternalGzipWorks 20{ 21 my $lex = new LexFile my $outfile; 22 my $content = qq { 23Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 24 dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 25 est. Quintus cenum parat. 26}; 27 28 writeWithGzip($outfile, $content) 29 or return 0; 30 31 my $got ; 32 readWithGzip($outfile, $got) 33 or return 0; 34 35 if ($content ne $got) 36 { 37 diag "Uncompressed content is wrong"; 38 return 0 ; 39 } 40 41 return 1 ; 42} 43 44sub readWithGzip 45{ 46 my $file = shift ; 47 48 my $lex = new LexFile my $outfile; 49 50 my $comp = "$GZIP -dc" ; 51 52 if ( system("$comp $file >$outfile") == 0 ) 53 { 54 $_[0] = readFile($outfile); 55 return 1 56 } 57 58 diag "'$comp' failed: $?"; 59 return 0 ; 60} 61 62sub getGzipInfo 63{ 64 my $file = shift ; 65} 66 67sub writeWithGzip 68{ 69 my $file = shift ; 70 my $content = shift ; 71 my $options = shift || ''; 72 73 my $lex = new LexFile my $infile; 74 writeFile($infile, $content); 75 76 unlink $file ; 77 my $comp = "$GZIP -c $options $infile >$file" ; 78 79 return 1 80 if system($comp) == 0 ; 81 82 diag "'$comp' failed: $?"; 83 return 0 ; 84} 85 86BEGIN { 87 88 # Check external gzip is available 89 my $name = $^O =~ /mswin/i ? 'gzip.exe' : 'gzip'; 90 my $split = $^O =~ /mswin/i ? ";" : ":"; 91 92 for my $dir (reverse split $split, $ENV{PATH}) 93 { 94 $GZIP = "$dir/$name" 95 if -x "$dir/$name" ; 96 } 97 98 plan(skip_all => "Cannot find $name") 99 if ! $GZIP ; 100 101 plan(skip_all => "$name doesn't work as expected") 102 if ! ExternalGzipWorks(); 103 104 105 # use Test::NoWarnings, if available 106 my $extra = 0 ; 107 $extra = 1 108 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 109 110 plan tests => 7 + $extra ; 111 112 use_ok('IO::Compress::Gzip', ':all') ; 113 use_ok('IO::Uncompress::Gunzip', ':all') ; 114 115} 116 117 118{ 119 title "Test interop with $GZIP" ; 120 121 my $file; 122 my $file1; 123 my $lex = new LexFile $file, $file1; 124 my $content = qq { 125Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 126 dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 127 est. Quintus cenum parat. 128}; 129 my $got; 130 131 ok writeWithGzip($file, $content), "writeWithGzip ok"; 132 133 gunzip $file => \$got ; 134 is $got, $content, "got content"; 135 136 137 gzip \$content => $file1; 138 $got = ''; 139 ok readWithGzip($file1, $got), "readWithGzip ok"; 140 is $got, $content, "got content"; 141} 142 143 144