use strict;

# Shared defs for test programs

# Paths. Must make case-insensitive.

use File::Temp qw(tempfile tempdir);

use File::Spec;

BEGIN { mkdir 'testdir' }

use constant TESTDIR => do {

    my $tmpdir = File::Spec->abs2rel(tempdir(DIR => 'testdir', CLEANUP => 1));

    $tmpdir =~ s!\\!/!g if $^O eq 'MSWin32';

    $tmpdir

};

use constant INPUTZIP =>

  (tempfile('testin-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1];

use constant OUTPUTZIP =>

  (tempfile('testout-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1];

# 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);

use Archive::Zip ();

# 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);

# 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');

        my $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 = 1;

    if (HAVEUNZIP) {

        my ($status, $zipout) = do { local $testZipDoesntWork = 0; testZip(INPUTZIP) };

            # 9 * 256 = 2304 - the specified zipfiles were not found

        $testZipDoesntWork = (($status == 0 || $status == 2304) ? 0 : 1);

        # 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");

        }

    }

}

sub passthrough

{

    my $fromFile = shift ;

    my $toFile = shift ;

    my $action = shift ;

    my $z = Archive::Zip->new; 

    $z->read($fromFile);

    if ($action)

    {

        for my $member($z->members())

        {

            &$action($member) ; 

        }

    }

    $z->writeToFileNamed($toFile);

}

sub readFile

{

    my $name = shift ;

    local $/;

    open F, "<$name"

        or die "Cannot open $name: $!\n";

    my $data = <F>;

    close F ;

    return $data;

}

1;