136 lines
2.4 KiB
Perl
136 lines
2.4 KiB
Perl
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 Exporter;
|
|
our @ISA = qw/ Exporter /;
|
|
our @EXPORT = qw/
|
|
are_hardlinked
|
|
file_exists
|
|
filemtime
|
|
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 $gen_ident = sub {
|
|
my ($dev, $ino) = stat $_[0];
|
|
return "$dev:$ino";
|
|
};
|
|
|
|
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 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);
|
|
|
|
use IPC::Open3 qw/ open3 /;
|
|
my $stderr = File::Temp->new(
|
|
TMPDIR => 1,
|
|
CLEANUP => 1,
|
|
);
|
|
my $stdout = File::Temp->new(
|
|
TMPDIR => 1,
|
|
CLEANUP => 1,
|
|
);
|
|
my $in = '';
|
|
local *CATCHOUT = $stdout;
|
|
local *CATCHERR = $stderr;
|
|
print STDERR "+ @cmd\n";
|
|
my $pid = open3 $in, '>&CATCHOUT', '>&CATCHERR', @cmd;
|
|
waitpid $pid, 0;
|
|
foreach my $handle (\*CATCHOUT, \*CATCHERR) {
|
|
seek $handle, 0, 0;
|
|
}
|
|
|
|
return (
|
|
$?,
|
|
(join "\n", <CATCHOUT>),
|
|
(join "\n", <CATCHERR>)
|
|
);
|
|
}
|
|
|
|
sub run_script {
|
|
my @args = @_;
|
|
print STDERR '+ ' . SCRIPT . " @args\n";
|
|
return system SCRIPT, @args;
|
|
}
|
|
|
|
1;
|