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