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