summaryrefslogtreecommitdiff
path: root/t/03-filesystem.t
diff options
context:
space:
mode:
Diffstat (limited to 't/03-filesystem.t')
-rw-r--r--t/03-filesystem.t372
1 files changed, 372 insertions, 0 deletions
diff --git a/t/03-filesystem.t b/t/03-filesystem.t
new file mode 100644
index 0000000..f9fe625
--- /dev/null
+++ b/t/03-filesystem.t
@@ -0,0 +1,372 @@
+use strict;
+use Test::More;
+use File::Temp qw(tmpnam tempdir);
+
+plan tests => 103;
+
+use_ok 'Path::Class';
+
+
+my $file = file(scalar tmpnam());
+ok $file, "Got a filename via tmpnam()";
+
+{
+ my $fh = $file->open('w');
+ ok $fh, "Opened $file for writing";
+
+ ok print( $fh "Foo\n"), "Printed to $file";
+}
+
+ok -e $file, "$file should exist";
+
+{
+ my $fh = $file->open;
+ is scalar <$fh>, "Foo\n", "Read contents of $file correctly";
+}
+
+{
+ my $stat = $file->stat;
+ ok $stat;
+ cmp_ok $stat->mtime, '>', time() - 20; # Modified within last 20 seconds
+
+ $stat = $file->dir->stat;
+ ok $stat;
+}
+
+1 while unlink $file;
+ok not -e $file;
+
+
+my $dir = dir(tempdir(CLEANUP => 1));
+ok $dir;
+ok -d $dir;
+
+$file = $dir->file('foo.x');
+$file->touch;
+ok -e $file;
+
+{
+ my $dh = $dir->open;
+ ok $dh, "Opened $dir for reading";
+
+ my @files = readdir $dh;
+ is scalar @files, 3;
+ ok scalar grep { $_ eq 'foo.x' } @files;
+}
+
+ok $dir->rmtree, "Removed $dir";
+ok !-e $dir, "$dir no longer exists";
+
+{
+ $dir = dir('t', 'foo', 'bar');
+ $dir->parent->rmtree if -e $dir->parent;
+
+ ok $dir->mkpath, "Created $dir";
+ ok -d $dir, "$dir is a directory";
+
+ # Use a Unix sample path to test cleaning it up
+ my $ugly = Path::Class::Dir->new_foreign(Unix => 't/foo/..//foo/bar');
+ $ugly->resolve;
+ is $ugly->as_foreign('Unix'), 't/foo/bar';
+
+ $dir = $dir->parent;
+ ok $dir->rmtree;
+ ok !-e $dir;
+}
+
+{
+ $dir = dir('t', 'foo');
+ ok $dir->mkpath;
+ ok $dir->subdir('dir')->mkpath;
+ ok -d $dir->subdir('dir');
+
+ ok $dir->file('file.x')->touch;
+ ok $dir->file('0')->touch;
+ my @contents;
+ while (my $file = $dir->next) {
+ push @contents, $file;
+ }
+ is scalar @contents, 5;
+
+ my $joined = join ' ', sort map $_->basename, grep {-f $_} @contents;
+ is $joined, '0 file.x';
+
+ my ($subdir) = grep {$_ eq $dir->subdir('dir')} @contents;
+ ok $subdir;
+ is -d $subdir, 1;
+
+ my ($file) = grep {$_ eq $dir->file('file.x')} @contents;
+ ok $file;
+ is -d $file, '';
+
+ ok $dir->rmtree;
+ ok !-e $dir;
+
+
+ # Try again with directory called '0', in curdir
+ my $orig = dir()->absolute;
+
+ ok $dir->mkpath;
+ ok chdir($dir);
+ my $dir2 = dir();
+ ok $dir2->subdir('0')->mkpath;
+ ok -d $dir2->subdir('0');
+
+ @contents = ();
+ while (my $file = $dir2->next) {
+ push @contents, $file;
+ }
+ ok grep {$_ eq '0'} @contents;
+
+ ok chdir($orig);
+ ok $dir->rmtree;
+ ok !-e $dir;
+}
+
+{
+ my $file = file('t', 'slurp');
+ ok $file;
+
+ my $fh = $file->open('w') or die "Can't create $file: $!";
+ print $fh "Line1\nLine2\n";
+ close $fh;
+ ok -e $file;
+
+ my $content = $file->slurp;
+ is $content, "Line1\nLine2\n";
+
+ my @content = $file->slurp;
+ is_deeply \@content, ["Line1\n", "Line2\n"];
+
+ @content = $file->slurp(chomp => 1);
+ is_deeply \@content, ["Line1", "Line2"];
+
+ is_deeply [ $file->slurp( chomp => 1, split => qr/n/ ) ]
+ => [ [ 'Li', 'e1' ], [ 'Li', 'e2' ] ],
+ "regex split with chomp";
+
+ is_deeply [ $file->slurp( chomp => 1, split => 'n' ) ]
+ => [ [ 'Li', 'e1' ], [ 'Li', 'e2' ] ],
+ "string split with chomp";
+
+ $file->remove;
+ ok not -e $file;
+}
+
+SKIP: {
+ my $file = file('t', 'slurp');
+ ok $file;
+
+ skip "IO modes not available until perl 5.7.1", 5
+ unless $^V ge v5.7.1;
+
+ my $fh = $file->open('>:raw') or die "Can't create $file: $!";
+ print $fh "Line1\r\nLine2\r\n\302\261\r\n";
+ close $fh;
+ ok -e $file;
+
+ my $content = $file->slurp(iomode => '<:raw');
+ is $content, "Line1\r\nLine2\r\n\302\261\r\n";
+
+ my $line3 = "\302\261\n";
+ utf8::decode($line3);
+ my @content = $file->slurp(iomode => '<:crlf:utf8');
+ is_deeply \@content, ["Line1\n", "Line2\n", $line3];
+
+ chop($line3);
+ @content = $file->slurp(chomp => 1, iomode => '<:crlf:utf8');
+ is_deeply \@content, ["Line1", "Line2", $line3];
+
+ $file->remove;
+ ok not -e $file;
+}
+
+{
+ my $file = file('t', 'spew');
+ $file->remove() if -e $file;
+ $file->spew( iomode => '>:raw', "Line1\r\n" );
+ $file->spew( iomode => '>>', "Line2" );
+
+ my $content = $file->slurp( iomode => '<:raw');
+
+ is( $content, "Line1\r\nLine2" );
+
+ $file->remove;
+ ok not -e $file;
+}
+
+{
+ my $file = file('t', 'spew_lines');
+ $file->remove() if -e $file;
+ $file->spew_lines( iomode => '>:raw', "Line1" );
+ $file->spew_lines( iomode => '>>:raw', [qw/Line2 Line3/] );
+
+ my $content = $file->slurp( iomode => '<:raw');
+
+ is( $content, "Line1$/Line2$/Line3$/" );
+
+ $file->remove;
+ ok not -e $file;
+}
+
+{
+ # Make sure we can make an absolute/relative roundtrip
+ my $cwd = dir();
+ is $cwd, $cwd->absolute->relative, "from $cwd to ".$cwd->absolute." to ".$cwd->absolute->relative;
+}
+
+{
+ my $t = dir('t');
+ my $foo_bar = $t->subdir('foo','bar');
+ $foo_bar->rmtree; # Make sure it doesn't exist
+
+ ok $t->subsumes($foo_bar), "t subsumes t/foo/bar";
+ ok !$t->contains($foo_bar), "t doesn't contain t/foo/bar";
+
+ $foo_bar->mkpath;
+ ok $t->subsumes($foo_bar), "t still subsumes t/foo/bar";
+ ok $t->contains($foo_bar), "t now contains t/foo/bar";
+
+ $t->subdir('foo')->rmtree;
+}
+
+{
+ # Test recursive iteration through the following structure:
+ # a
+ # / \
+ # b c
+ # / \ \
+ # d e f
+ # / \ \
+ # g h i
+ (my $abe = dir(qw(a b e)))->mkpath;
+ (my $acf = dir(qw(a c f)))->mkpath;
+ file($acf, 'i')->touch;
+ file($abe, 'h')->touch;
+ file($abe, 'g')->touch;
+ file('a', 'b', 'd')->touch;
+
+ my $a = dir('a');
+
+ # Make sure the children() method works ok
+ my @children = sort map $_->as_foreign('Unix'), $a->children;
+ is_deeply \@children, ['a/b', 'a/c'];
+
+ {
+ recurse_test( $a,
+ preorder => 1, depthfirst => 0, # The default
+ precedence => [qw(a a/b
+ a a/c
+ a/b a/b/e/h
+ a/b a/c/f/i
+ a/c a/b/e/h
+ a/c a/c/f/i
+ )],
+ );
+ }
+
+ {
+ my $files =
+ recurse_test( $a,
+ preorder => 1, depthfirst => 1,
+ precedence => [qw(a a/b
+ a a/c
+ a/b a/b/e/h
+ a/c a/c/f/i
+ )],
+ );
+ is_depthfirst($files);
+ }
+
+ {
+ my $files =
+ recurse_test( $a,
+ preorder => 0, depthfirst => 1,
+ precedence => [qw(a/b a
+ a/c a
+ a/b/e/h a/b
+ a/c/f/i a/c
+ )],
+ );
+ is_depthfirst($files);
+ }
+
+
+ $a->rmtree;
+
+ sub is_depthfirst {
+ my $files = shift;
+ if ($files->{'a/b'} < $files->{'a/c'}) {
+ cmp_ok $files->{'a/b/e'}, '<', $files->{'a/c'}, "Ensure depth-first search";
+ } else {
+ cmp_ok $files->{'a/c/f'}, '<', $files->{'a/b'}, "Ensure depth-first search";
+ }
+ }
+
+ sub recurse_test {
+ my ($dir, %args) = @_;
+ my $precedence = delete $args{precedence};
+ my ($i, %files) = (0);
+ $a->recurse( callback => sub {$files{shift->as_foreign('Unix')->stringify} = ++$i},
+ %args );
+ while (my ($pre, $post) = splice @$precedence, 0, 2) {
+ cmp_ok $files{$pre}, '<', $files{$post}, "$pre should come before $post";
+ }
+ return \%files;
+ }
+}
+
+{
+ $dir = Path::Class::tempdir();
+ isa_ok $dir, 'Path::Class::Dir';
+
+ $dir = Path::Class::tempdir(CLEANUP => 1);
+ isa_ok $dir, 'Path::Class::Dir';
+}
+
+# copy_to()
+{
+ my $file1 = file('t', 'file1');
+ my $file2 = file('t', 'file2');
+ $file1->spew("some contents");
+ ok -e $file1;
+
+ my $copy = $file1->copy_to($file2);
+
+ isa_ok $copy, "Path::Class::File";
+ is($copy->stringify, $file2->stringify, "same file");
+
+ ok -e $file2;
+ is($file2->slurp, "some contents");
+
+ my $dir = dir('t', 'dir');
+ $dir->mkpath;
+ $file1->copy_to($dir);
+ my $dest = $dir->file($file1->basename);
+ ok -e $dest;
+ is($dest->slurp, "some contents");
+
+ $_->remove for ($file1, $file2);
+ $dir->rmtree;
+ ok( ! -e $_, "$_ should be removed") for ($file1, $file2, $dir);
+}
+
+# move_to()
+{
+ my $file1 = file('t', 'file1');
+ my $src = file('t', 'file1');
+
+ my $file2 = file('t', 'file2');
+ $file1->spew("some contents");
+ ok -e $file1;
+
+ my $move = $file1->move_to($file2);
+ ok -e $file2;
+ is($file2->slurp, "some contents");
+ ok ! -e $src;
+
+ is($file1->stringify, $file2->stringify);
+
+ $file2->remove;
+ ok( ! -e $_, "$_ should be gone") for ($file1, $file2);
+}
View Lorry Controller Status