The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Shared defs for test programs

# Paths. Must make case-insensitive.
use constant TESTDIR   => 'testdir';
use constant INPUTZIP  => 'testin.zip';
use constant OUTPUTZIP => 'testout.zip';

# Do we have the 'zip' and 'unzip' programs?
# Embed a copy of the module, rather than adding a dependency
BEGIN {
	package File::Which;

	use File::Spec;

	my $Is_VMS    = ($^O eq 'VMS');
	my $Is_MacOS  = ($^O eq 'MacOS');
	my $Is_DOSish = (($^O eq 'MSWin32') or
                	($^O eq 'dos')     or
                	($^O eq 'os2'));

	# For Win32 systems, stores the extensions used for
	# executable files
	# For others, the empty string is used
	# because 'perl' . '' eq 'perl' => easier
	my @path_ext = ('');
	if ($Is_DOSish) {
    	if ($ENV{PATHEXT} and $Is_DOSish) {    # WinNT. PATHEXT might be set on Cygwin, but not used.
	        push @path_ext, split ';', $ENV{PATHEXT};
    	}
    	else {
	        push @path_ext, qw(.com .exe .bat); # Win9X or other: doesn't have PATHEXT, so needs hardcoded.
    	}
	}
	elsif ($Is_VMS) { 
    	push @path_ext, qw(.exe .com);
	}

	sub which {
    	my ($exec) = @_;

    	return undef unless $exec;

    	my $all = wantarray;
    	my @results = ();
    
	    # check for aliases first
	    if ($Is_VMS) {
	        my $symbol = `SHOW SYMBOL $exec`;
	        chomp($symbol);
	        if (!$?) {
	            return $symbol unless $all;
	            push @results, $symbol;
	        }
	    }
	    if ($Is_MacOS) {
	        my @aliases = split /\,/, $ENV{Aliases};
	        foreach my $alias (@aliases) {
	            # This has not been tested!!
	            # PPT which says MPW-Perl cannot resolve `Alias $alias`,
	            # let's just hope it's fixed
	            if (lc($alias) eq lc($exec)) {
	                chomp(my $file = `Alias $alias`);
	                last unless $file;  # if it failed, just go on the normal way
	                return $file unless $all;
	                push @results, $file;
	                # we can stop this loop as if it finds more aliases matching,
	                # it'll just be the same result anyway
	                last;
	            }
	        }
	    }
	
	    my @path = File::Spec->path();
	    unshift @path, File::Spec->curdir if $Is_DOSish or $Is_VMS or $Is_MacOS;
	
	    for my $base (map { File::Spec->catfile($_, $exec) } @path) {
	       for my $ext (@path_ext) {
	            my $file = $base.$ext;
	# print STDERR "$file\n";
	
	            if ((-x $file or    # executable, normal case
	                 ($Is_MacOS ||  # MacOS doesn't mark as executable so we check -e
	                  ($Is_DOSish and grep { $file =~ /$_$/i } @path_ext[1..$#path_ext])
	                                # DOSish systems don't pass -x on non-exe/bat/com files.
	                                # so we check -e. However, we don't want to pass -e on files
	                                # that aren't in PATHEXT, like README.
	                 and -e _)
	                ) and !-d _)
	            {                   # and finally, we don't want dirs to pass (as they are -x)
	
	# print STDERR "-x: ", -x $file, " -e: ", -e _, " -d: ", -d _, "\n";
	
	                    return $file unless $all;
	                    push @results, $file;       # Make list to return later
	            }
	        }
	    }
	    
	    if($all) {
	        return @results;
	    } else {
	        return undef;
	    }
	}
}
use constant HAVEZIP   => !! File::Which::which('zip');
use constant HAVEUNZIP => !! File::Which::which('unzip');

use constant ZIP     => 'zip ';
use constant ZIPTEST => 'unzip -t ';

# 300-character test string
use constant TESTSTRING       => join ( "\n", 1 .. 102 ) . "\n";
use constant TESTSTRINGLENGTH => length(TESTSTRING);

# CRC-32 should be ac373f32
use constant TESTSTRINGCRC => Archive::Zip::computeCRC32(TESTSTRING);

# This is so that it will work on other systems.
use constant CAT     => $^X . ' -pe "BEGIN{binmode(STDIN);binmode(STDOUT)}"';
use constant CATPIPE => '| ' . CAT . ' >';

use vars qw($zipWorks $testZipDoesntWork $catWorks);
local ( $zipWorks, $testZipDoesntWork, $catWorks );

# Run ZIPTEST to test a zip file.
sub testZip {
	my $zipName = shift || OUTPUTZIP;
	if ( $testZipDoesntWork ) {
		return wantarray ? ( 0, '' ) : 0;
	}
	my $cmd = ZIPTEST . $zipName . ( $^O eq 'MSWin32' ? '' : ' 2>&1' );
	my $zipout = `$cmd`;
	return wantarray ? ( $?, $zipout ) : $?;
}

# Return the crc-32 of the given file (0 if empty or error)
sub fileCRC {
	my $fileName = shift;
	local $/ = undef;
	my $fh = IO::File->new( $fileName, "r" );
	binmode($fh);
	return 0 if not defined($fh);
	my $contents = <$fh>;
	return Archive::Zip::computeCRC32($contents);
}

#--------- check to see if cat works

sub testCat {
	my $fh = IO::File->new( CATPIPE . OUTPUTZIP );
	binmode($fh);
	my $testString = pack( 'C256', 0 .. 255 );
	my $testCrc    = Archive::Zip::computeCRC32($testString);
	$fh->write( $testString, length($testString) ) or return 0;
	$fh->close();
	( -f OUTPUTZIP ) or return 0;
	my @stat = stat(OUTPUTZIP);
	$stat[7] == length($testString) or return 0;
	fileCRC(OUTPUTZIP) == $testCrc or return 0;
	unlink(OUTPUTZIP);
	return 1;
}

BEGIN {
	$catWorks = testCat();
	unless ( $catWorks ) {
		warn( 'warning: ', CAT, " doesn't seem to work, may skip some tests" );
	}
}

#--------- check to see if zip works (and make INPUTZIP)

BEGIN {
	unlink(INPUTZIP);

	# Do we have zip installed?
	if ( HAVEZIP ) {
		my $cmd    = ZIP . INPUTZIP . ' *' . ( $^O eq 'MSWin32' ? '' : ' 2>&1' );
		$zipout = `$cmd`;
		$zipWorks  = not $?;
		unless ( $zipWorks ) {
			warn( 'warning: ', ZIP, " doesn't seem to work, may skip some tests" );
		}
	}
}

#--------- check to see if unzip -t works

BEGIN {
	$testZipDoesntWork = 0;
	if ( HAVEUNZIP ) {
		my ( $status, $zipout ) = testZip(INPUTZIP);
		$testZipDoesntWork = $status;

		# Again, on Win32 no big surprise if this doesn't work
		if ( $testZipDoesntWork ) {
			warn( 'warning: ', ZIPTEST, " doesn't seem to work, may skip some tests" );
		}
	}
}

1;