1package FilePathTest; 2use strict; 3use warnings; 4use base 'Exporter'; 5use SelectSaver; 6use Cwd; 7use File::Spec::Functions; 8 9our @EXPORT = qw(_run_for_warning _run_for_verbose _basedir 10 _cannot_delete_safe_mode 11 _verbose_expected); 12 13sub _basedir { 14 return catdir( curdir(), 15 sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ), 16 ); 17 18} 19 20sub _run_for_warning { 21 my $coderef = shift; 22 my $warn = ''; 23 local $SIG{__WARN__} = sub { $warn .= shift }; 24 &$coderef; 25 return $warn; 26} 27 28sub _run_for_verbose { 29 my $coderef = shift; 30 my $stdout = ''; 31 { 32 my $guard = SelectSaver->new(_ref_to_fh(\$stdout)); 33 &$coderef; 34 } 35 return $stdout; 36} 37 38sub _ref_to_fh { 39 my $output = shift; 40 open my $fh, '>', $output; 41 return $fh; 42} 43 44# Whether a directory can be deleted without modifying permissions varies 45# by platform and by current privileges, so we really have to do the same 46# check the module does in safe mode to determine that. 47 48sub _cannot_delete_safe_mode { 49 my $path = shift; 50 return $^O eq 'VMS' 51 ? !&VMS::Filespec::candelete($path) 52 : !-w $path; 53} 54 55# What verbose mode reports depends on what it can do in safe mode. 56# Plus on VMS, mkpath may report what it's operating on in a 57# different format from the format of the path passed to it. 58 59sub _verbose_expected { 60 my ($function, $path, $safe_mode, $base) = @_; 61 my $expected; 62 63 if ($function =~ m/^(mkpath|make_path)$/) { 64 # On VMS, mkpath reports in Unix format. Maddeningly, it 65 # reports the top-level directory without a trailing slash 66 # and everything else with. 67 if ($^O eq 'VMS') { 68 $path = VMS::Filespec::unixify($path); 69 $path =~ s/\/$// if defined $base && $base; 70 } 71 $expected = "mkdir $path\n"; 72 } 73 elsif ($function =~ m/^(rmtree|remove_tree)$/) { 74 # N.B. Directories must still/already exist for this to work. 75 $expected = $safe_mode && _cannot_delete_safe_mode($path) 76 ? "skipped $path\n" 77 : "rmdir $path\n"; 78 } 79 elsif ($function =~ m/^(unlink)$/) { 80 $expected = "unlink $path\n"; 81 $expected =~ s/\n\z/\.\n/ if $^O eq 'VMS'; 82 } 83 else { 84 die "Unknown function $function in _verbose_expected"; 85 } 86 return $expected; 87} 88 89BEGIN { 90 if ($] < 5.008000) { 91 eval qq{#line @{[__LINE__+1]} "@{[__FILE__]}"\n} . <<'END' or die $@; 92 no warnings 'redefine'; 93 use Symbol (); 94 95 sub _ref_to_fh { 96 my $output = shift; 97 my $fh = Symbol::gensym(); 98 tie *$fh, 'StringIO', $output; 99 return $fh; 100 } 101 102 package StringIO; 103 sub TIEHANDLE { bless [ $_[1] ], $_[0] } 104 sub CLOSE { @{$_[0]} = (); 1 } 105 sub PRINT { ${ $_[0][0] } .= $_[1] } 106 sub PRINTF { ${ $_[0][0] } .= sprintf $_[1], @_[2..$#_] } 107 1; 108END 109 } 110} 111 1121; 113