1use strict; 2use warnings; 3 4use Test::More; 5use Cwd (); 6use Prima::sys::Test qw(noX11); 7use Prima::Utils; 8use Prima::sys::FS; 9use Fcntl qw(:DEFAULT S_IFREG S_IFDIR); 10use utf8; 11 12my $fn = "f.f.f"; 13my $dn = "d.d.d"; 14unlink $fn; 15unlink $dn; 16 17plan skip_all => "cannot write file:$!" 18 unless open F, ">", $fn; 19close F; 20ok( -f $fn, "file created"); 21unlink $fn; 22 23unless ( mkdir $dn ) { 24 unlink $fn; 25 plan skip_all => "cannot mkdir: $!"; 26} 27ok( -d $dn, "dir created"); 28rmdir $dn; 29 30sub check 31{ 32 my ( $id, $fn, $dn ) = @_; 33 34 my $ok; 35 my $fd = Prima::Utils::open_file($fn, O_CREAT|O_WRONLY); 36 ok($fd, "$id: open file ok"); 37 diag($!) unless $fd; 38 my $fh; 39 $ok = CORE::open $fh, ">&=", $fd; 40 ok($ok, "$id: fdopen"); 41 diag($!) unless $ok; 42 $ok = print $fh "Hello world!\n"; 43 ok($ok, "$id: print"); 44 close $fh; 45 46 ok($ok = mkdir($dn), "$id: mkdir ok"); 47 diag($!) unless $ok; 48 49 my @l = getdir('.'); 50 my ($found_file, $found_dir) = (0,0); 51 for (my $i = 0; $i < @l; $i += 2 ) { 52 $found_file = $l[$i+1] if $l[$i] eq $fn; 53 $found_dir = $l[$i+1] if $l[$i] eq $dn; 54 } 55 ok( $found_file eq 'reg', "$id: getdir file"); 56 ok( $found_dir eq 'dir', "$id: getdir dir"); 57 58 my $d; 59 ok( opendir($d, '.'), "opendir"); 60 my $start = telldir($d); 61 @l = readdir($d); 62 ($found_file, $found_dir) = (0,0); 63 for (my $i = 0; $i < @l; $i++ ) { 64 $found_file = 1 if $l[$i] eq $fn; 65 $found_dir = 1 if $l[$i] eq $dn; 66 } 67 ok( $found_file, "$id: readdir file"); 68 ok( $found_dir , "$id: readdir dir"); 69 seekdir($d, $start); 70 @l = readdir($d); 71 ($found_file, $found_dir) = (0,0); 72 for (my $i = 0; $i < @l; $i++ ) { 73 $found_file = 1 if $l[$i] eq $fn; 74 $found_dir = 1 if $l[$i] eq $dn; 75 } 76 ok( $found_file, "$id: rewind/readdir file"); 77 ok( $found_dir , "$id: rewind/readdir dir"); 78 seekdir($d, $start); 79 scalar readdir($d); 80 my $pos = telldir $d; 81 seekdir($d, $start); 82 seekdir $d, $pos; 83 is($pos, telldir $d, "telldir") if $^O !~ /freebsd/ || `uname -r` !~ /^([02-9]|10)/; 84 my @r = readdir $d; 85 ok( @r < @l, "seekdir/telldir"); 86 87 ok( closedir($d), "closedir"); 88 89 is( _f $fn, 1, "$id: _f file = 1"); 90 is( _d $dn, 1, "$id: _d dir = 1"); 91 is( _d $fn, 0, "$id: _d file = 0"); 92 is( _f $dn, 0, "$id: _f dir = 0"); 93 94 @l = stat($fn); 95 ok(scalar(@l), "$id: stat file"); 96 diag($!) unless @l; 97 ok( $l[2] & S_IFREG, "$id: stat file is file"); 98 99 @l = stat($dn); 100 ok(scalar(@l), "$id: stat dir"); 101 diag($!) unless @l; 102 ok( $l[2] & S_IFDIR, "$id: stat dir is dir"); 103 104 my $cwd = getcwd; 105 ok( $ok = chdir($dn), "$id: chdir"); 106 diag($!) unless $ok; 107 my $ncwd = getcwd; 108 setenv( PWD => $ncwd ); 109 is( getenv( 'PWD' ), $ncwd, "$id: getenv"); 110 111 my $dn_local = Prima::Utils::sv2local($dn); 112 if ( defined $dn_local ) { 113 my $cwd = Cwd::getcwd(); 114 CORE::chdir $dn_local; 115 like( Cwd::getcwd(), qr/\Q$dn_local\E/, "$id: chdir back-compat"); 116 CORE::chdir $cwd; 117 chdir($ncwd); 118 119 my $test = "$dn\0$dn"; 120 my $loc = Prima::Utils::sv2local($test); 121 is( length($loc), length($dn_local) * 2 + 1, "$id: sv2local"); 122 is(Prima::Utils::local2sv($loc), $test, "$id: local2sv"); 123 } 124 125 $ok = open(F, ">", 1); 126 diag($!) unless $ok; 127 close F; 128 ok( $ok, "$id: create file in subdir"); 129 ok( $ok = rename('1', $fn), "$id: rename"); 130 diag($!) unless $ok; 131 ok( $ok = chdir($cwd), "$id: chdir back"); 132 diag($!) unless $ok; 133 134 ok($ok = unlink("$ncwd/$fn"), "$id: unlink in subdir"); 135 diag(getcwd, $!) unless $ok; 136 137 ok($ok = unlink($fn), "$id: unlink file"); 138 diag(getcwd, $!) unless $ok; 139 140 ok($ok = rmdir($dn), "$id: unlink dir"); 141 diag(getcwd, $!) unless $ok; 142 143 ok( !scalar(stat($fn)), "$id: really unlink file"); 144 ok( !scalar(stat($dn)), "$id: really unlink dir"); 145} 146 147check("en", $fn, $dn); 148check("ru", "файл", "фолдер"); 149check("zh", "文件", "目录"); 150 151done_testing; 152