view release on metacpan or  search on metacpan

t/002-main.t  view on Meta::CPAN

# Env variables
#
# ZIPDETAILS_TEST_MATCH         only run test that match regex
# ZIPDETAILS_TEST_KEEP_OUTPUT   keep the output from all tests
# ZIPDETAILS_TEST_DIFF          run "diff" if the output isn't correct
# ZIPDETAILS_TEST_REFRESH       refresh the stdout/stderr files
# ZIPDETAILS_COVERAGE           run Devel::NYTProf profiler

#
#  nytprofmerge --out nytprof.out `find -name \*nytprof.out`
#  nytprofhtml --open
#

use 5.010;

use strict;
use warnings;
use feature 'say';
use feature 'state';

use Cwd;
use Test::More ;
use Data::Dumper ;
use File::Temp qw( tempdir);
use File::Basename;
use File::Find;
use Fcntl qw(SEEK_SET);


my $tests_per_zip = 6  ;
my $tests_per_zip_full = $tests_per_zip * 2 * 3 * 2 ;

my $test_count = 1 ;
$test_count += 240 if -e 't/files';

plan tests => $test_count * $tests_per_zip_full ;

sub run;
sub compareWithGolden;

my $tempdir = tempdir(CLEANUP => 1);
my $HERE = getcwd;
my $zipdetails_binary = "$HERE/bin/zipdetails";

my $ZSTD = findZstd();


my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
$Perl = qq["$Perl"] if $^O eq 'MSWin32' ;

my %dirs;
my @exts = qw(
   aar
    apk
    cbz
    crx
    dwf
    epub
    exe
    fmu
    ipa
    ja
    jar
    jmod

t/002-main.t  view on Meta::CPAN

                    if ($opt3 && $golden_stdout !~ /$opt3$/)
                    {
                        skip "No Redact test for " . basename($zipfile), $tests_per_zip;
                    }

                    my ($status, $stdout, $stderr) = run $zipfile, $opt1, $opt2, $options, $golden_stdout_file, $golden_stderr_file ;

                    my $ok = 1;
                    $ok &= is $status, $exit_status, "Exit Status is $exit_status [got $status] for '$test'";
                    $ok &= compareWithGolden  $golden_stdout_file, $stdout, $golden_stdout, "Expected stdout[$golden_stdout_name] for '$test'";
                    $ok &= compareWithGolden  $golden_stderr_file, $stderr, $golden_stderr, "Expected stderr[$golden_stderr_name] for '$test'";

                    $ok &= compareBytesWithZipFile($opt1, $opt2, $opt3, $zipfile, $stdout);

                    push @failed, "$dir $opt1 $opt2"
                        unless $ok;
                }
            }
        }

        unlink <$tempdir/*> ;
    }
}

if (@failed)
{
    diag "Failed tests are" ;
    diag "  $_" for @failed;
}

exit;

sub readOutFile
{
    my $basename = shift;

    return "" unless $basename;

    if (! -e $basename && -f "$basename.zst")
    {
        return `$ZSTD -d -c $basename`;
    }
    if (-f $basename )
    {
        return readFile($basename);
    }

    return "";
}

sub run
{
    my $filename = shift ;
    my $opt1 = shift ;
    my $opt2 = shift ;
    my $options = shift;
    my $stdout_golden = shift ;
    my $stderr_golden = shift ;

    my $keep = defined $ENV{ZIPDETAILS_TEST_KEEP_OUTPUT};
    my $stdout ;
    my $stderr ;

    if ($keep)
    {
        $stdout = $stdout_golden . ".got";
        $stderr = $stderr_golden . ".got";
    }
    else
    {
        $stdout = "$tempdir/stdout";
        $stderr = "$tempdir/stderr";
    }

    unlink $stdout
        if -e $stdout;

    unlink $stderr
        if -e $stderr;

    ok ! -e $stdout, "stdout file does not exist" ;
    ok ! -e $stderr, "stderr file does not exist" ;

    my $basename = basename($filename);
    # say "basename is $basename";
    my $dir = dirname($filename);

    my $here = getcwd;
    chdir $dir;

    local $ENV{NYTPROF} .= ":file=./" . basename($stdout_golden) . ".nytprof.out" ;

    # diag "RUN " . qq[$Perl $COVERAGE $zipdetails_binary --utc $opt1 $opt2 $options "$basename" >"$stdout" 2>"$stderr"];
    my $got = system(qq[$Perl $COVERAGE $zipdetails_binary --utc $opt1 $opt2 $options "$basename" >"$stdout" 2>"$stderr"]);

    chdir $here;

    $got = $? >>= 8;
    my $out = readFile($stdout);
    my $err = readFile($stderr);

    # normalise EOL
    $out =~ s/\r\n/\n/g;
    $err =~ s/\r\n/\n/g;

    unlink $stdout, $stderr
        unless $keep;

    return ($got, $out, $err) ;
}

sub findZstd
{
    # Check external Zstd is available
    my $name  = $^O =~ /mswin/i ? 'zstd.exe' : 'zstd';
    my $split = $^O =~ /mswin/i ? ";" : ":";

    my $zstd ;
    for my $dir (reverse split $split, $ENV{PATH})
    {