simplify_static_dir/t/TestFunctions.pm

package TestFunctions;
use strict;
use warnings;

require Archive::Tar;
use Cwd qw/
    abs_path
    chdir
    getcwd
/;
use File::Basename qw/
    dirname
/;
require File::Temp;
use IPC::Open3 qw/ open3 /;
use Symbol qw/ gensym /;

use Exporter;
use parent 'Exporter';
## no critic ( Modules::ProhibitAutomaticExportation )
# This is a test function library, it's not production code...
our @EXPORT = qw/
    are_hardlinked
    file_exists
    filemtime
    gen_ident
    has_mtime
    mktempdir
    prep_tar
    run_script
    run_script_capture
/;

use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplify_static_dir-main.pl';

sub are_hardlinked {
    my ($starter, @files) = @_;

    my $starter_ident = gen_ident($starter);
    foreach my $file (@files) {
        if (gen_ident($file) ne $starter_ident) {
            return 0;
        }
    }
    return 1;
}

sub file_exists {
    my @files = @_;
    foreach my $file (@files) {
        unless (-e $file) {
            return 0;
        }
    }
    return 1;
}

sub filemtime {
    my $file = shift;
    return (stat $file)[9];
}

sub gen_ident {
    my $file = shift;
    my ($dev, $ino) = stat $file;
    return "$dev:$ino";
}

sub has_mtime {
    my ($mtime, @files) = @_;
    foreach my $file (@files) {
        if (filemtime($file) != $mtime) {
            return 0;
        }
    }
    return 1;
}

sub mktempdir {
    return File::Temp->newdir(
        TEMPLATE => 'tests.XXXXXX',
        TMPDIR => 1,
        CLEANUP => 1,
    );
}

sub prep_tar {
    my $tarball = shift // (dirname(__FILE__) . '/t.tar');

    my $td = mktempdir();

    # Note: Using chdir from Cwd automatically keeps $ENV{PWD} up-to-date (just
    # in case)
    my $oldpwd = getcwd();

    chdir $td;
    my $tar = Archive::Tar->new;
    $tar->read($tarball);
    $tar->extract();
    chdir $oldpwd;

    return $td;
}

sub run_script_capture {
    my @args = @_;
    my @cmd = (SCRIPT, @args);
    my $in = '';
    my $child_out = gensym();
    my $child_err = gensym();
    print STDERR "+ @cmd\n";
    my $pid = open3 $in, $child_out, $child_err, @cmd;
    waitpid $pid, 0;
    foreach my $handle ($child_out, $child_err) {
        seek $handle, 0, 0;
    }

    local $/;
    return (
        $?,
        scalar <$child_out>, # slurp!
        scalar <$child_err>, # slurp!
    );
}

sub run_script {
    my @args = @_;
    print STDERR '+ ' . SCRIPT . " @args\n";
    return system SCRIPT, @args;
}

1;