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