1#!./perl 2 3use strict; 4use File::Temp qw( tempdir ); 5use Cwd; 6 7no strict 'subs'; 8 9BEGIN { 10 require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); 11 plan(16); 12 13 use_ok('IO::Dir'); 14 IO::Dir->import(DIR_UNLINK); 15} 16 17my $cwd = cwd(); 18 19{ 20 my $DIR = tempdir( CLEANUP => 1 ); 21 chdir $DIR or die "Unable to chdir to $DIR"; 22 my @IO_files = 23 ( 'ChangeLog', 'IO.pm', 'IO.xs', 'Makefile.PL', 'poll.c', 'poll.h', 'README' ); 24 my @IO_subdirs = ( qw| hints lib t | ); 25 26 for my $f (@IO_files) { 27 open my $OUT, '>', $f or die "Unable to open '$DIR/$f' for writing"; 28 close $OUT or die "Unable to close '$DIR/$f' after writing"; 29 } 30 for my $d (@IO_subdirs) { mkdir $d or die "Unable to mkdir '$DIR/$d'"; } 31 32 my $CLASS = "IO::Dir"; 33 my $dot = $CLASS->new($DIR); 34 ok(defined($dot), "Able to create IO::Dir object for $DIR"); 35 36 my @a = sort <*>; 37 my $first; 38 do { $first = $dot->read } while defined($first) && $first =~ /^\./; 39 ok(+(grep { $_ eq $first } @a), "directory entry found"); 40 41 my @b = sort($first, (grep {/^[^.]/} $dot->read)); 42 ok(+(join("\0", @a) eq join("\0", @b)), "two lists of directory entries match (Case 1)"); 43 44 ok($dot->rewind,'rewind'); 45 my @c = sort grep {/^[^.]/} $dot->read; 46 ok(+(join("\0", @b) eq join("\0", @c)), "two lists of directory entries match (Case 2)"); 47 48 ok($dot->close,'close'); 49 { 50 local $^W; # avoid warnings on invalid dirhandle 51 ok(!$dot->rewind, "rewind on closed"); 52 ok(!defined($dot->read), "Directory handle closed; 'read' returns undef"); 53 } 54 55 open(FH,'>','X') || die "Can't create x"; 56 print FH "X"; 57 close(FH) or die "Can't close: $!"; 58 59 my %dir; 60 tie %dir, $CLASS, $DIR; 61 my @files = keys %dir; 62 63 # I hope we do not have an empty dir :-) 64 ok(scalar @files, "Tied hash interface finds directory entries"); 65 66 my $stat = $dir{'X'}; 67 isa_ok($stat,'File::stat'); 68 ok(defined($stat) && $stat->size == 1, 69 "Confirm that we wrote a file of size 1 byte"); 70 71 delete $dir{'X'}; 72 73 ok(-f 'X', "File still exists after tied hash entry deleted"); 74 75 my %dirx; 76 tie %dirx, $CLASS, $DIR, DIR_UNLINK; 77 78 my $statx = $dirx{'X'}; 79 isa_ok($statx,'File::stat'); 80 ok(defined($statx) && $statx->size == 1, 81 "Confirm that we still have the 1-byte file"); 82 83 delete $dirx{'X'}; 84 85 ok(!(-f 'X'), "Using DIR_UNLINK deletes tied hash element and directory entry"); 86 87 chdir $cwd or die "Unable to chdir back to $cwd"; 88} 89 90