131 lines
2.3 KiB
Perl
131 lines
2.3 KiB
Perl
package TestFunctions;
|
|
# vi: et sts=4 sw=4 ts=4
|
|
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 = shift;
|
|
|
|
my $gen_ident = sub {
|
|
my ($dev, $ino) = stat $_[0];
|
|
return "$dev:$ino";
|
|
};
|
|
|
|
my $starter_ident = &$gen_ident($starter);
|
|
foreach my $file (@_) {
|
|
if (&$gen_ident($file) ne $starter_ident) {
|
|
return 0;
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub file_exists {
|
|
foreach my $file (@_) {
|
|
unless (-e $file) {
|
|
return 0;
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub filemtime {
|
|
(stat shift)[9];
|
|
}
|
|
|
|
sub has_mtime {
|
|
my $mtime = shift;
|
|
foreach my $file (@_) {
|
|
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 @cmd =(SCRIPT, @_);
|
|
|
|
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;
|
|
seek $_, 0, 0 for \*CATCHOUT, \*CATCHERR;
|
|
|
|
return (
|
|
$?,
|
|
(join "\n", <CATCHOUT>),
|
|
(join "\n", <CATCHERR>)
|
|
);
|
|
}
|
|
|
|
sub run_script {
|
|
print STDERR '+ ' . SCRIPT . " @_\n";
|
|
system SCRIPT, @_;
|
|
}
|
|
|
|
1;
|