/usr/share/perl5/Test/Dir/Base.pm is in libtest-dir-perl 1.16-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | =head1 NAME
Test::Dir::Base - support functions for Test::Dir and Test::Folder
=head1 DESCRIPTION
This module is not meant to be human-readable.
Use Test::Dir or Test::Folder.
=head1 AUTHOR
Martin 'Kingpin' Thurn, C<mthurn at cpan.org>, L<http://tinyurl.com/nn67z>.
=cut
package Test::Dir::Base;
our
$VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
use Test::Builder;
my $Test = new Test::Builder;
our $directory = q{directory};
our $dir = q{dir};
our $Directory = q{Directory};
our $Dir = q{Dir};
# All functions start with underscore so that Test::Pod::Coverage does
# not complain about lack of pod.
sub _declare
{
my $iOK = shift || 0;
my $sName = shift || q{};
my $sDiag = shift || q{};
if ($iOK)
{
$Test->ok(1, $sName);
}
else
{
$Test->diag($sDiag);
$Test->ok(0, $sName);
}
} # _declare
sub _dir_exists_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir exists";
my $iOK = -d $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] does not exist});
} # _dir_exists_ok
sub _dir_not_exists_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir does not exist";
my $iOK = ! -d $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] does not exist});
} # _dir_not_exists_ok
sub _dir_empty_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is empty";
my $iOK = -d $sDir && _dir_is_empty($sDir);
_declare($iOK, $sName, qq{$directory [$sDir] is not empty});
} # _dir_empty_ok
sub _dir_not_empty_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is not empty";
my $iOK = -d $sDir && ! _dir_is_empty($sDir);
_declare($iOK, $sName, qq{$directory [$sDir] is empty});
} # _dir_empty_ok
sub _dir_is_empty
{
my $path = shift || return;
my $iRet = 1;
opendir DIR, $path or die;
READDIR:
while (my $entry = readdir DIR)
{
next READDIR if ($entry =~ m/\A\.\.?\z/);
$iRet = 0;
last READDIR;
} # while
closedir DIR;
return $iRet;
} # _dir_is_empty
sub _dir_readable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is readable";
my $iOK = -d $sDir && -r $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is not readable});
} # _dir_readable_ok
sub _dir_not_readable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is not readable";
my $iOK = -d $sDir && ! -r $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is readable});
} # _dir_not_readable_ok
sub _dir_writable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is writable";
my $iOK = -d $sDir && -w $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is not writable});
} # _dir_writable_ok
sub _dir_not_writable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is not writable";
my $iOK = -d $sDir && ! -w $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is writable});
} # _dir_not_writable_ok
sub _dir_executable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is executable";
my $iOK = -d $sDir && -x $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is not executable});
} # _dir_executable_ok
sub _dir_not_executable_ok
{
my $sDir = shift;
my $sName = shift || "$dir $sDir is not executable";
my $iOK = -d $sDir && ! -x $sDir;
_declare($iOK, $sName, qq{$directory [$sDir] is executable});
} # _dir_not_executable_ok
1;
__END__
|