# -*- perl -*-
# t/03_absolute.t - Absolute file spec test
use strict;
use Test::More;
BEGIN {
if ( $^O =~ /vms/i ) {
plan skip_all => "Cannot test absolute POSIX files on this platform";
}
else {
plan tests => 19;
}
#01
use_ok('File::Wildcard');
}
use File::Spec;
my $debug = $ENV{FILE_WILDCARD_DEBUG} || 0;
my $temp = File::Spec->tmpdir . '/File-Wildcard-test';
$temp =~ s!\\!/!g; # for Windows silly slash direction
# Just in case the temp directory is lying around...
if ( -e $temp ) {
my $wcrm = File::Wildcard->new(
path => "$temp///",
ellipsis_order => "inside-out"
);
for ( $wcrm->all ) {
if ( -d $_ ) {
rmdir $_;
}
else {
1 while unlink $_;
}
}
}
mkdir $temp;
mkdir "$temp/abs";
mkdir "$temp/abs/foo";
mkdir "$temp/abs/bar";
open FOO, ">$temp/abs/foo/lish.tmp";
close FOO;
open FOO, ">$temp/abs/bar/drink.tmp";
close FOO;
# Force the case sensitivity for absolute files
# as it says in the docs
my $sens = Filesys::Type::case($temp) ne 'sensitive';
my $mods = File::Wildcard->new(
path => "$temp/abs/foo/lish.tmp",
case_insensitive => $sens,
debug => $debug
);
#02
isa_ok( $mods, 'File::Wildcard', "return from new" );
#03
like( $mods->next, qr"$temp/abs/foo/lish.tmp"i, 'Simple case, no wildcard' );
#04
ok( !$mods->next, 'Only found one file' );
my ( $junk, @chunks ) = split m'/', "$temp/abs/*/*.tmp";
$mods = File::Wildcard->new(
path => \@chunks,
case_insensitive => $sens,
debug => $debug,
absolute => 1,
sort => 1
);
#05
isa_ok( $mods, 'File::Wildcard', "return from new" );
my @found = $mods->all;
SKIP:
{
skip 'This test unreliable on Windows', 1 if $^O =~ /win/i;
#06
is_deeply(
\@found,
[ "$temp/abs/bar/drink.tmp", "$temp/abs/foo/lish.tmp" ],
'Wildcard in filename'
);
}
$mods = File::Wildcard->new(
path => "$temp///*.tmp",
case_insensitive => $sens,
debug => $debug,
sort => 1
);
#07
isa_ok( $mods, 'File::Wildcard', "(ellipsis) return from new" );
@found = $mods->all;
#08
is_deeply(
\@found,
[ "$temp/abs/bar/drink.tmp", "$temp/abs/foo/lish.tmp" ],
'Ellipsis found tmp files'
);
$mods = File::Wildcard->new(
path => "$temp///",
case_insensitive => $sens,
debug => $debug,
sort => 1
);
#09
isa_ok( $mods, 'File::Wildcard', "(ellipsis) return from new" );
@found = $mods->all;
#10
is_deeply(
\@found,
[ "$temp/", "$temp/abs/",
"$temp/abs/bar/", "$temp/abs/bar/drink.tmp",
"$temp/abs/foo/", "$temp/abs/foo/lish.tmp",
],
'Recursive directory search (normal)'
);
$mods = File::Wildcard->new(
path => "$temp///",
case_insensitive => $sens,
debug => $debug,
sort => sub { $_[1] cmp $_[0] }
);
#11
isa_ok( $mods, 'File::Wildcard', "(ellipsis) return from new" );
@found = $mods->all;
#12
is_deeply(
\@found,
[ "$temp/", "$temp/abs/",
"$temp/abs/foo/", "$temp/abs/foo/lish.tmp",
"$temp/abs/bar/", "$temp/abs/bar/drink.tmp",
],
'Recursive directory search (custom sort)'
);
$mods = File::Wildcard->new(
path => "$temp///",
case_insensitive => $sens,
debug => $debug,
sort => 1,
ellipsis_order => 'breadth-first'
);
#13
isa_ok( $mods, 'File::Wildcard', "(ellipsis) return from new" );
@found = $mods->all;
# Note that breadth-first skips the topmost level
# I have not found an easy way round this.
#14
is_deeply(
\@found,
[ "$temp/abs/", "$temp/abs/bar/",
"$temp/abs/foo/", "$temp/abs/bar/drink.tmp",
"$temp/abs/foo/lish.tmp",
],
'Recursive directory search (breadth-first)'
);
# Append absolute bug
$mods = File::Wildcard->new(
debug => $debug,
sort => 1
);
$mods->append( path => "$temp///*.tmp" );
@found = $mods->all;
#15
is_deeply(
\@found,
[ "$temp/abs/bar/drink.tmp", "$temp/abs/foo/lish.tmp" ],
"Appended absolute"
);
$mods = File::Wildcard->new(
path => "$temp///",
case_insensitive => $sens,
debug => $debug,
sort => 1,
ellipsis_order => 'inside-out'
);
#16
isa_ok( $mods, 'File::Wildcard', "(ellipsis) return from new" );
@found = $mods->all;
#17
is_deeply(
\@found,
[ "$temp/abs/bar/drink.tmp", "$temp/abs/bar/",
"$temp/abs/foo/lish.tmp", "$temp/abs/foo/",
"$temp/abs/", "$temp/",
],
'Recursive directory search (inside-out)'
);
$mods->append( path => "$temp///" );
@found = $mods->all;
#18
is_deeply(
\@found,
[ "$temp/abs/bar/drink.tmp", "$temp/abs/bar/",
"$temp/abs/foo/lish.tmp", "$temp/abs/foo/",
"$temp/abs/", "$temp/",
],
'Append to absolute'
);
# Tidy up after tests
for (@found) {
if ( -d $_ ) {
rmdir $_;
}
else {
1 while unlink $_;
}
}
rmdir $temp;
#19
ok( !-e $temp, "Test has tidied up after itself" );