1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
package FileSlurpTest;
use strict;
use warnings;
use Exporter qw(import);
use IO::Handle ();
use File::Spec ();
use File::Temp qw(tempfile);
use File::Slurp ();
our @EXPORT_OK = qw(
IS_WSL temp_file_path trap_function trap_function_list_context
);
sub IS_WSL() {
if ($^O eq 'linux') {
require POSIX;
return 1 if (POSIX::uname())[2] =~ /windows/i;
}
}
sub temp_file_path {
my ($pick_nonsense_path) = @_;
# older EUMMs turn this on. We don't want to emit warnings.
# also, some of our CORE function overrides emit warnings. Silence those.
local $^W;
my $file;
if ($pick_nonsense_path) {
$file = File::Spec->catfile(File::Spec->tmpdir, 'super', 'bad', 'file-slurp', 'path');
}
else {
(undef, $file) = tempfile('tempXXXXX', DIR => File::Spec->tmpdir, OPEN => 0);
}
return $file;
}
sub trap_function {
my ($function, @args) = @_;
my $res;
my $warn;
my $err = do { # catch
local $@;
local $SIG{__WARN__} = sub {$warn = join '', @_};
eval { # try
$res = $function->(@args);
1;
};
$@;
};
return ($res, $warn, $err);
}
sub trap_function_list_context {
my ($function, @args) = @_;
my @res;
my $warn;
my $err = do { # catch
local $@;
local $SIG{__WARN__} = sub {$warn = join '', @_};
eval { # try
@res = $function->(@args);
1;
};
$@;
};
return (\@res, $warn, $err);
}
1;
|
