package FilePathTest; use strict; use warnings; use base 'Exporter'; use SelectSaver; use Carp; use Cwd; use File::Spec::Functions; use File::Path (); use Test::More (); our @EXPORT_OK = qw( _run_for_warning _run_for_verbose _cannot_delete_safe_mode _verbose_expected create_3_level_subdirs cleanup_3_level_subdirs ); 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 } } sub create_3_level_subdirs { my @dirnames = @_; my %seen = map {$_ => 1} @dirnames; croak "Need 3 distinct names for subdirectories" unless scalar(keys %seen) == 3; my $tdir = File::Spec::Functions::tmpdir(); my $least_deep = catdir($tdir, $dirnames[0]); my $next_deepest = catdir($least_deep, $dirnames[1]); my $deepest = catdir($next_deepest, $dirnames[2]); return ($least_deep, $next_deepest, $deepest); } sub cleanup_3_level_subdirs { # runs 2 tests my $least_deep = shift; croak "Must provide path of least subdirectory" unless (length($least_deep) and (-d $least_deep)); my $x; my $opts = { error => \$x }; File::Path::remove_tree($least_deep, $opts); Test::More::ok(! -d $least_deep, "directory '$least_deep' removed, as expected"); Test::More::is(scalar(@{$x}), 0, "no error messages using remove_tree() with \$opts"); } 1;