1
2use strict;
3use Test::More;
4use File::Temp qw(tmpnam tempdir);
5use File::Spec;
6
7plan tests => 72;
8
9use_ok 'Path::Class';
10
11
12my $file = file(scalar tmpnam());
13ok $file, "Got a filename via tmpnam()";
14
15{
16  my $fh = $file->open('w');
17  ok $fh, "Opened $file for writing";
18  
19  ok print( $fh "Foo\n"), "Printed to $file";
20}
21
22ok -e $file, "$file should exist";
23
24{
25  my $fh = $file->open;
26  is scalar <$fh>, "Foo\n", "Read contents of $file correctly";
27}
28
29{
30  my $stat = $file->stat;
31  ok $stat;
32  cmp_ok $stat->mtime, '>', time() - 20;  # Modified within last 20 seconds
33
34  $stat = $file->dir->stat;
35  ok $stat;
36}
37
381 while unlink $file;
39ok not -e $file;
40
41
42my $dir = dir(tempdir(CLEANUP => 1));
43ok $dir;
44ok -d $dir;
45
46$file = $dir->file('foo.x');
47$file->touch;
48ok -e $file;
49
50{
51  my $dh = $dir->open;
52  ok $dh, "Opened $dir for reading";
53
54  my @files = readdir $dh;
55  is scalar @files, 3;
56  ok scalar grep { $_ eq 'foo.x' } @files;
57}
58
59ok $dir->rmtree, "Removed $dir";
60ok !-e $dir, "$dir no longer exists";
61
62{
63  $dir = dir('t', 'foo', 'bar');
64  $dir->parent->rmtree if -e $dir->parent;
65
66  ok $dir->mkpath, "Created $dir";
67  ok -d $dir, "$dir is a directory";
68
69  # Use a Unix sample path to test cleaning it up
70  my $ugly = Path::Class::Dir->new_foreign(Unix => 't/foo/..//foo/bar');
71  $ugly->resolve;
72  is $ugly->as_foreign('Unix'), 't/foo/bar';
73  
74  $dir = $dir->parent;
75  ok $dir->rmtree;
76  ok !-e $dir;
77}
78
79{
80  $dir = dir('t', 'foo');
81  ok $dir->mkpath;
82  ok $dir->subdir('dir')->mkpath;
83  ok -d $dir->subdir('dir');
84  
85  ok $dir->file('file.x')->touch;
86  ok $dir->file('0')->touch;
87  my @contents;
88  while (my $file = $dir->next) {
89    push @contents, $file;
90  }
91  is scalar @contents, 5;
92
93  my $joined = join ' ', sort map $_->basename, grep {-f $_} @contents;
94  is $joined, '0 file.x';
95  
96  my ($subdir) = grep {$_ eq $dir->subdir('dir')} @contents;
97  ok $subdir;
98  is -d $subdir, 1;
99
100  my ($file) = grep {$_ eq $dir->file('file.x')} @contents;
101  ok $file;
102  is -d $file, '';
103  
104  ok $dir->rmtree;
105  ok !-e $dir;
106
107
108  # Try again with directory called '0', in curdir
109  my $orig = dir()->absolute;
110
111  ok $dir->mkpath;
112  ok chdir($dir);
113  my $dir2 = dir();
114  ok $dir2->subdir('0')->mkpath;
115  ok -d $dir2->subdir('0');
116
117  @contents = ();
118  while (my $file = $dir2->next) {
119    push @contents, $file;
120  }
121  ok grep {$_ eq '0'} @contents;
122
123  ok chdir($orig);
124  ok $dir->rmtree;
125  ok !-e $dir;
126}
127
128{
129  my $file = file('t', 'slurp');
130  ok $file;
131  
132  my $fh = $file->open('w') or die "Can't create $file: $!";
133  print $fh "Line1\nLine2\n";
134  close $fh;
135  ok -e $file;
136  
137  my $content = $file->slurp;
138  is $content, "Line1\nLine2\n";
139  
140  my @content = $file->slurp;
141  is_deeply \@content, ["Line1\n", "Line2\n"];
142
143  @content = $file->slurp(chomp => 1);
144  is_deeply \@content, ["Line1", "Line2"];
145
146  $file->remove;
147  ok not -e $file;
148}
149
150{
151  # Make sure we can make an absolute/relative roundtrip
152  my $cwd = dir();
153  is $cwd, $cwd->absolute->relative, "from $cwd to ".$cwd->absolute." to ".$cwd->absolute->relative;
154}
155
156{
157  my $t = dir('t');
158  my $foo_bar = $t->subdir('foo','bar');
159  $foo_bar->rmtree; # Make sure it doesn't exist
160
161  ok  $t->subsumes($foo_bar), "t subsumes t/foo/bar";
162  ok !$t->contains($foo_bar), "t doesn't contain t/foo/bar";
163
164  $foo_bar->mkpath;
165  ok  $t->subsumes($foo_bar), "t still subsumes t/foo/bar";
166  ok  $t->contains($foo_bar), "t now contains t/foo/bar";
167
168  $t->subdir('foo')->rmtree;
169}
170
171{
172  # Test recursive iteration through the following structure:
173  #     a
174  #    / \
175  #   b   c
176  #  / \   \
177  # d   e   f
178  #    / \   \
179  #   g   h   i
180  (my $abe = dir(qw(a b e)))->mkpath;
181  (my $acf = dir(qw(a c f)))->mkpath;
182  file($acf, 'i')->touch;
183  file($abe, 'h')->touch;
184  file($abe, 'g')->touch;
185  file('a', 'b', 'd')->touch;
186
187  my $a = dir('a');
188
189  # Make sure the children() method works ok
190  my @children = sort map $_->as_foreign('Unix'), $a->children;
191  is_deeply \@children, ['a/b', 'a/c'];
192  
193  {
194    recurse_test( $a,
195		  preorder => 1, depthfirst => 0,  # The default
196		  precedence => [qw(a           a/b
197				    a           a/c
198				    a/b         a/b/e/h
199				    a/b         a/c/f/i
200				    a/c         a/b/e/h
201				    a/c         a/c/f/i
202				   )],
203		);
204  }
205
206  {
207    my $files = 
208      recurse_test( $a,
209		    preorder => 1, depthfirst => 1,
210		    precedence => [qw(a           a/b
211				      a           a/c
212				      a/b         a/b/e/h
213				      a/c         a/c/f/i
214				     )],
215		  );
216    is_depthfirst($files);
217  }
218
219  {
220    my $files = 
221      recurse_test( $a,
222		    preorder => 0, depthfirst => 1,
223		    precedence => [qw(a/b         a
224				      a/c         a
225				      a/b/e/h     a/b
226				      a/c/f/i     a/c
227				     )],
228		  );
229    is_depthfirst($files);
230  }
231  
232
233  $a->rmtree;
234
235  sub is_depthfirst {
236    my $files = shift;
237    if ($files->{'a/b'} < $files->{'a/c'}) {
238      cmp_ok $files->{'a/b/e'}, '<', $files->{'a/c'}, "Ensure depth-first search";
239    } else {
240      cmp_ok $files->{'a/c/f'}, '<', $files->{'a/b'}, "Ensure depth-first search";
241    }
242  }
243
244  sub recurse_test {
245    my ($dir, %args) = @_;
246    my $precedence = delete $args{precedence};
247    my ($i, %files) = (0);
248    $a->recurse( callback => sub {$files{shift->as_foreign('Unix')->stringify} = ++$i},
249		 %args );
250    while (my ($pre, $post) = splice @$precedence, 0, 2) {
251      cmp_ok $files{$pre}, '<', $files{$post}, "$pre should come before $post";
252    }
253    return \%files;
254  }
255}
256