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 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
|
use strict;
use warnings;
# the original intent of this test was to isolate and test solely the
# list_dir method, but it became immediatley apparent that you can't
# very well test list_dir() unless you have a good directory tree first;
# this led to the combining of the make_dir and list_dir testing routines
use Test::More tests => 25;
use Test::NoWarnings;
use Cwd;
use File::Temp qw( tempdir );
use lib './lib';
use File::Util qw( SL NL OS );
# one recognized instantiation setting
my $ftl = File::Util->new( );
my $tempdir = tempdir( CLEANUP => 1 );
my $testbed = $tempdir . SL . $$ . SL . time;
my $tmpf = $testbed . SL . 'tmptest';
my $have_perms = $ftl->is_writable( $tempdir );
my @test_files = qw/
a.txt b.log
c.ini d.bat
e.sh f.conf
g.bin h.rc
/;
for my $tfile ( @test_files )
{
ok(
$ftl->touch( $testbed . SL . $tfile ) == 1,
'create files in a directory that does not exist beforehand'
);
}
is_deeply
(
[ sort $ftl->list_dir( $testbed, '--recurse' ) ],
[ sort map { $testbed . SL . $_ } @test_files ],
'test recursive listing with classic call style arguments'
);
my $deeper = $testbed . SL . 'foo' . SL . 'bar';
# make a deeper directory
is
(
$ftl->make_dir( $deeper ), $deeper,
'make a deeper directory'
);
for my $tfile ( @test_files )
{
ok
(
$ftl->touch( $deeper . SL . $tfile ) == 1,
'create files in a abs path directory that already exists'
);
}
is_deeply
(
[ sort $ftl->list_dir( $deeper => { recurse => 1 } ) ],
[ sort map { $deeper . SL . $_ } @test_files ],
'test recursive file listing with modern call style'
);
is_deeply
(
[ sort $ftl->list_dir( $deeper, '--recurse' ) ],
[ sort map { $deeper . SL . $_ } @test_files ],
'test recursive file listing with classic call style'
);
is_deeply
(
[
sort map { $ftl->strip_path( $_ ) } $ftl->list_dir
(
$testbed => { recurse => 1, files_only => 1 }
)
],
[ sort @test_files, @test_files ],
'same, but using modern call style, ' .
'stripped of fully qualified paths'
);
is_deeply
(
[
sort map { $ftl->strip_path( $_ ) } $ftl->list_dir
(
$testbed => { recurse => 1 }, { files_only => 1 }
)
],
[ sort @test_files, @test_files ],
'same, but using intentionally wrong modern call style, ' .
'stripped of fully qualified paths'
);
my @cbstack;
sub callback
{
my ( $currdir, $subdirs, $files, $depth ) = @_;
push @cbstack, @$subdirs;
push @cbstack, @$files;
return;
}
$ftl->list_dir( $tempdir => { callback => \&callback, recurse => 1 } );
my @list_as_lines = $ftl->list_dir( $tempdir => { recurse => 1 } );
is_deeply
[ sort { uc $a cmp uc $b } @cbstack ],
[ sort { uc $a cmp uc $b } @list_as_lines ],
'compare recursive listing to recursive callback return';
SKIP: {
# this would work on windows except it's directory separator is not "/"
# so we wouldn't get an exact match on each hash key's value.
skip 'these tests are for testing by the author and only run on Unix/Linux', 1
unless
(
(
$ENV{RELEASE_TESTING} || $ENV{AUTHOR_TESTING} || $ENV{AUTHOR_TESTS}
) && ( $^O =~ /bsd|linux|cygwin|solaris|aix/i || OS eq 'UNIX' )
);
my $tree = setup_test_tree();
my $indir = getcwd;
chdir $tree;
is_deeply $ftl->list_dir( '.' => { recurse => 1, as_tree => 1 } ),
{
'.' => {
'_DIR_PARENT_' => undef,
'_DIR_SELF_' => '.',
'a.txt' => './a.txt',
'b.log' => './b.log',
'c.ini' => './c.ini',
'd.bat' => './d.bat',
'e.sh' => './e.sh',
'f.conf' => './f.conf',
'g.bin' => './g.bin',
'h.rc' => './h.rc',
'xfoo' => {
'_DIR_PARENT_' => '.',
'_DIR_SELF_' => './xfoo',
'zbar' => {
'_DIR_PARENT_' => './xfoo',
'_DIR_SELF_' => './xfoo/zbar',
'i.jpg' => './xfoo/zbar/i.jpg',
'j.xls' => './xfoo/zbar/j.xls',
'k.ppt' => './xfoo/zbar/k.ppt',
'l.scr' => './xfoo/zbar/l.scr',
'm.html' => './xfoo/zbar/m.html',
'n.js' => './xfoo/zbar/n.js',
'o.css' => './xfoo/zbar/o.css',
'p.avi' => './xfoo/zbar/p.avi',
},
},
}
}, 'list_dir( "." => { recurse => 1, as_tree => 1 } ) - works OK';
chdir $indir;
}
exit;
sub setup_test_tree {
my $tempdir = tempdir( CLEANUP => 1 );
my @test_files = qw(
a.txt b.log
c.ini d.bat
e.sh f.conf
g.bin h.rc
);
for my $tfile ( @test_files )
{
$ftl->touch( $tempdir . SL . $tfile );
}
my $deeper = $tempdir . SL . 'xfoo' . SL . 'zbar';
$ftl->make_dir( $deeper );
@test_files = qw(
i.jpg j.xls
k.ppt l.scr
m.html n.js
o.css p.avi
);
for my $tfile ( @test_files )
{
$ftl->write_file( { file => $deeper . SL . $tfile, content => rand } );
}
return $tempdir;
}
|