1package Testing; 2use 5.006_001; 3use strict; 4use warnings; 5use Exporter 'import'; 6our @EXPORT_OK = qw( 7 create_file_ok 8 mkdir_ok 9 symlink_ok 10 dir_path 11 file_path 12 _cleanup_start 13); 14 15# Wrappers around Test::More::ok() for creation of files, directories and 16# symlinks used in testing of File-Find 17 18*ok = \&Test::More::ok; 19 20sub create_file_ok($;$) { 21 my $file = $_[0]; 22 my $msg = $_[2] || "able to create file: $file"; 23 ok( open(my $T,'>',$file), $msg ) 24 or die("Unable to create file: $file"); 25} 26 27sub mkdir_ok($$;$) { 28 my ($dir, $mask) = @_[0..1]; 29 my $msg = $_[2] || "able to mkdir: $dir"; 30 ok( mkdir($dir, $mask), $msg ) 31 or die("Unable to mkdir $!: $dir"); 32} 33 34sub symlink_ok($$;$) { 35 my ($oldfile, $newfile) = @_[0..1]; 36 my $msg = $_[2] || "able to symlink from $oldfile to $newfile"; 37 ok( symlink( $oldfile, $newfile ), $msg) 38 or die("Unable to symlink from $oldfile to $newfile"); 39} 40 41# Use dir_path() to specify a directory path that is expected for 42# $File::Find::dir (%Expect_Dir). Also use it in file operations like 43# chdir, rmdir etc. 44# 45# dir_path() concatenates directory names to form a *relative* 46# directory path, independent from the platform it is run on, although 47# there are limitations. Do not try to create an absolute path, 48# because that may fail on operating systems that have the concept of 49# volume names (e.g. Mac OS). As a special case, you can pass it a "." 50# as first argument, to create a directory path like "./fa/dir". If there is 51# no second argument, this function will return "./" 52 53sub dir_path { 54 my $first_arg = shift @_; 55 56 if ($first_arg eq '.') { 57 return './' unless @_; 58 my $path = File::Spec->catdir(@_); 59 # add leading "./" 60 $path = "./$path"; 61 return $path; 62 } 63 else { # $first_arg ne '.' 64 return $first_arg unless @_; # return plain filename 65 my $fname = File::Spec->catdir($first_arg, @_); # relative path 66 $fname = VMS::Filespec::unixpath($fname) if $^O eq 'VMS'; 67 return $fname; 68 } 69} 70 71# Use file_path() to specify a file path that is expected for $_ 72# (%Expect_File). Also suitable for file operations like unlink etc. 73# 74# file_path() concatenates directory names (if any) and a filename to 75# form a *relative* file path (the last argument is assumed to be a 76# file). It is independent from the platform it is run on, although 77# there are limitations. As a special case, you can pass it a "." as 78# first argument, to create a file path like "./fa/file" on operating 79# systems. If there is no second argument, this function will return the 80# string "./" 81 82sub file_path { 83 my $first_arg = shift @_; 84 85 if ($first_arg eq '.') { 86 return './' unless @_; 87 my $path = File::Spec->catfile(@_); 88 # add leading "./" 89 $path = "./$path"; 90 return $path; 91 } 92 else { # $first_arg ne '.' 93 return $first_arg unless @_; # return plain filename 94 my $fname = File::Spec->catfile($first_arg, @_); # relative path 95 $fname = VMS::Filespec::unixify($fname) if $^O eq 'VMS'; 96 return $fname; 97 } 98} 99 100sub _something_wrong { 101 my ($message) = @_; 102 warn "in cleanup: $message\n" . 103 "Something seems to be very wrong. Possibly the directory\n" . 104 "we are testing in has been removed or wiped while we ran?\n"; 105 return 0; 106} 107 108sub _cleanup_start { 109 my ($test_root_dir, $test_temp_dir)= @_; 110 111 # doing the following two chdirs (and their validation) in two 112 # distinct steps avoids the need to know about directory separators, 113 # or other FS specifics, which is helpful as the test files that use 114 # this function overrides the File::Spec heirarchy, so we can't ask it 115 # to help us here. 116 117 # chdir into the $test_root_dir to start the cleanup. But first validate. 118 if (!$test_root_dir) { 119 return _something_wrong("No test_root_dir?"); 120 } 121 if (!-d $test_root_dir) { 122 return _something_wrong("test_root_dir '$test_root_dir' seems to have disappeared!"); 123 } 124 chdir($test_root_dir) 125 or return _something_wrong("Failed to chdir to '$test_root_dir': $!"); 126 127 # chdir into the $test_temp_dir to start the cleanup. But first validate. 128 if (!$test_temp_dir) { 129 return _something_wrong("No test_temp_dir?"); 130 } 131 if (!-d $test_temp_dir) { 132 return _something_wrong("test_temp_dir '$test_temp_dir' seems to have disappeared!"); 133 } 134 chdir($test_temp_dir) 135 or return _wrong("Failed to chdir to '$test_temp_dir': $!"); 136 137 return 1; 138} 139 1401; 141