git.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/050interop-gzip.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  15
  16 my $GZIP ;
  17
  18
  19 sub ExternalGzipWorks
  20 {
  21     my $lex = new LexFile my $outfile;
  22     my $content = qq {
  23 Lorem 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
  44 sub 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
  62 sub getGzipInfo
  63 {
  64     my $file = shift ;
  65 }
  66
  67 sub 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
  86 BEGIN {
  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 {
 125 Lorem 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