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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
package FilePathTest;
use strict;
use warnings;
use base 'Exporter';
use SelectSaver;
use Cwd;
use File::Spec::Functions;
our @EXPORT = qw(_run_for_warning _run_for_verbose _basedir
_cannot_delete_safe_mode
_verbose_expected);
sub _basedir {
return catdir( curdir(),
sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ),
);
}
sub _run_for_warning {
my $coderef = shift;
my $warn = '';
local $SIG{__WARN__} = sub { $warn .= shift };
&$coderef;
return $warn;
}
sub _run_for_verbose {
my $coderef = shift;
my $stdout = '';
{
my $guard = SelectSaver->new(_ref_to_fh(\$stdout));
&$coderef;
}
return $stdout;
}
sub _ref_to_fh {
my $output = shift;
open my $fh, '>', $output;
return $fh;
}
# Whether a directory can be deleted without modifying permissions varies
# by platform and by current privileges, so we really have to do the same
# check the module does in safe mode to determine that.
sub _cannot_delete_safe_mode {
my $path = shift;
return $^O eq 'VMS'
? !&VMS::Filespec::candelete($path)
: !-w $path;
}
# What verbose mode reports depends on what it can do in safe mode.
# Plus on VMS, mkpath may report what it's operating on in a
# different format from the format of the path passed to it.
sub _verbose_expected {
my ($function, $path, $safe_mode, $base) = @_;
my $expected;
if ($function =~ m/^(mkpath|make_path)$/) {
# On VMS, mkpath reports in Unix format. Maddeningly, it
# reports the top-level directory without a trailing slash
# and everything else with.
if ($^O eq 'VMS') {
$path = VMS::Filespec::unixify($path);
$path =~ s/\/$// if defined $base && $base;
}
$expected = "mkdir $path\n";
}
elsif ($function =~ m/^(rmtree|remove_tree)$/) {
# N.B. Directories must still/already exist for this to work.
$expected = $safe_mode && _cannot_delete_safe_mode($path)
? "skipped $path\n"
: "rmdir $path\n";
}
elsif ($function =~ m/^(unlink)$/) {
$expected = "unlink $path\n";
$expected =~ s/\n\z/\.\n/ if $^O eq 'VMS';
}
else {
die "Unknown function $function in _verbose_expected";
}
return $expected;
}
BEGIN {
if ($] < 5.008000) {
eval qq{#line @{[__LINE__+1]} "@{[__FILE__]}"\n} . <<'END' or die $@;
no warnings 'redefine';
use Symbol ();
sub _ref_to_fh {
my $output = shift;
my $fh = Symbol::gensym();
tie *$fh, 'StringIO', $output;
return $fh;
}
package StringIO;
sub TIEHANDLE { bless [ $_[1] ], $_[0] }
sub CLOSE { @{$_[0]} = (); 1 }
sub PRINT { ${ $_[0][0] } .= $_[1] }
sub PRINTF { ${ $_[0][0] } .= sprintf $_[1], @_[2..$#_] }
1;
END
}
}
1;
|
