git.maemo.org Git - pkg-perl/blob - deb-src/libarchive-zip-perl/libarchive-zip-perl-1.18/t/common.pl

   1 # Shared defs for test programs
   2
   3 # Paths. Must make case-insensitive.
   4 use constant TESTDIR   => 'testdir';
   5 use constant INPUTZIP  => 'testin.zip';
   6 use constant OUTPUTZIP => 'testout.zip';
   7
   8 # Do we have the 'zip' and 'unzip' programs?
   9 use File::Which ();
  10 use constant HAVEZIP   => !! File::Which::which('zip');
  11 use constant HAVEUNZIP => !! File::Which::which('unzip');
  12
  13 use constant ZIP     => 'zip ';
  14 use constant ZIPTEST => 'unzip -t ';
  15
  16 # 300-character test string
  17 use constant TESTSTRING       => join ( "\n", 1 .. 102 ) . "\n";
  18 use constant TESTSTRINGLENGTH => length(TESTSTRING);
  19
  20 # CRC-32 should be ac373f32
  21 use constant TESTSTRINGCRC => Archive::Zip::computeCRC32(TESTSTRING);
  22
  23 # This is so that it will work on other systems.
  24 use constant CAT     => $^X . ' -pe "BEGIN{binmode(STDIN);binmode(STDOUT)}"';
  25 use constant CATPIPE => '| ' . CAT . ' >';
  26
  27 use vars qw($zipWorks $testZipDoesntWork $catWorks);
  28 local ( $zipWorks, $testZipDoesntWork, $catWorks );
  29
  30 # Run ZIPTEST to test a zip file.
  31 sub testZip {
  32         my $zipName = shift || OUTPUTZIP;
  33         if ( $testZipDoesntWork ) {
  34                 return wantarray ? ( 0, '' ) : 0;
  35         }
  36         my $cmd = ZIPTEST . $zipName . ( $^O eq 'MSWin32' ? '' : ' 2>&1' );
  37         my $zipout = `$cmd`;
  38         return wantarray ? ( $?, $zipout ) : $?;
  39 }
  40
  41 # Return the crc-32 of the given file (0 if empty or error)
  42 sub fileCRC {
  43         my $fileName = shift;
  44         local $/ = undef;
  45         my $fh = IO::File->new( $fileName, "r" );
  46         binmode($fh);
  47         return 0 if not defined($fh);
  48         my $contents = <$fh>;
  49         return Archive::Zip::computeCRC32($contents);
  50 }
  51
  52 #--------- check to see if cat works
  53
  54 sub testCat {
  55         my $fh = IO::File->new( CATPIPE . OUTPUTZIP );
  56         binmode($fh);
  57         my $testString = pack( 'C256', 0 .. 255 );
  58         my $testCrc    = Archive::Zip::computeCRC32($testString);
  59         $fh->write( $testString, length($testString) ) or return 0;
  60         $fh->close();
  61         ( -f OUTPUTZIP ) or return 0;
  62         my @stat = stat(OUTPUTZIP);
  63         $stat[7] == length($testString) or return 0;
  64         fileCRC(OUTPUTZIP) == $testCrc or return 0;
  65         unlink(OUTPUTZIP);
  66         return 1;
  67 }
  68
  69 BEGIN {
  70         $catWorks = testCat();
  71         unless ( $catWorks ) {
  72                 warn( 'warning: ', CAT, " doesn't seem to work, may skip some tests" );
  73         }
  74 }
  75
  76 #--------- check to see if zip works (and make INPUTZIP)
  77
  78 BEGIN {
  79         unlink(INPUTZIP);
  80
  81         # Do we have zip installed?
  82         if ( HAVEZIP ) {
  83                 my $cmd    = ZIP . INPUTZIP . ' *' . ( $^O eq 'MSWin32' ? '' : ' 2>&1' );
  84                 $zipout = `$cmd`;
  85                 $zipWorks  = not $?;
  86                 unless ( $zipWorks ) {
  87                         warn( 'warning: ', ZIP, " doesn't seem to work, may skip some tests" );
  88                 }
  89         }
  90 }
  91
  92 #--------- check to see if unzip -t works
  93
  94 BEGIN {
  95         $testZipDoesntWork = 0;
  96         if ( HAVEUNZIP ) {
  97                 my ( $status, $zipout ) = testZip(INPUTZIP);
  98                 $testZipDoesntWork = $status;
  99
 100                 # Again, on Win32 no big surprise if this doesn't work
 101                 if ( $testZipDoesntWork ) {
 102                         warn( 'warning: ', ZIPTEST, " doesn't seem to work, may skip some tests" );
 103                 }
 104         }
 105 }
 106
 107 1;