use strict;
use warnings;
use File::Basename;
use File::Path;
use File::System::Test;
use Test::More tests => 2774;
BEGIN { use_ok('File::System') }
-d 't/root' and rmtree('t/root', 1);
mkpath('t/root', 1, 0700);
-d 't/root2' and rmtree('t/root2', 1);
mkpath('t/root2', 1, 0700);
-d 't/root3' and rmtree('t/root3', 1);
mkpath('t/root3', 1, 0700);
-d 't/root4' and rmtree('t/root4', 1);
mkpath('t/root4', 1, 0700);
-d 't/root5' and rmtree('t/root5', 1);
mkpath('t/root5', 1, 0700);
my $root = File::System->new('Table',
'/' => [ 'Real', root => 't/root' ],
);
# Checking initial file system root
is_root_sane($root);
my @mounts = (
undef,
[ mount => '/bar' => 't/root2' => 't/root/bar' ],
[ mount => '/bar/baz' => 't/root3' => 't/root2/baz' ],
[ mount => '/bar/baz/qux' => 't/root4' => 't/root3/qux' ],
[ mount => '/.bar' => 't/root5' => 't/root/.bar' ],
[ unmount => '/bar/baz/qux' => 't/root4' => 't/root3/qux' ],
[ unmount => '/.bar' => 't/root5' => 't/root/.bar' ],
[ unmount => '/bar/baz' => 't/root3' => 't/root2/baz' ],
[ unmount => '/bar' => 't/root2' => 't/root/bar' ],
);
my %mounts = (
'/' => 't/root',
'/bar' => 't/root2',
'/bar/baz' => 't/root3',
'/bar/baz/qux' => 't/root4',
'/.bar' => 't/root5',
);
my @dirs = qw(
.bar .bar/.baz .bar/.baz/.qux .file2
bar bar/baz bar/baz/qux file2
);
my @files = qw(
.baz .file1 .file2/bar .file2/foo .file3 .file4 .foo .qux
baz file1 file2/bar file2/foo file3 file4 foo qux
);
my @expected_mounts = ( '/' );
is_deeply([ sort $root->mounts ], [ sort @expected_mounts ]);
for my $cmd (@mounts) {
if (defined $cmd && $cmd->[0] eq 'mount') {
$root->mount($cmd->[1], [ 'Real', root => $cmd->[2] ]);
push @expected_mounts, $cmd->[1];
is_deeply([ sort $root->mounts ], [ sort @expected_mounts ]);
} elsif (defined $cmd) {
$root->unmount($cmd->[1]);
@expected_mounts = grep { $cmd->[1] ne $_ } @expected_mounts;
is_deeply([ sort $root->mounts ], [ sort @expected_mounts ]);
}
# create
for my $path (@dirs) {
ok(defined $root->create($path, 'd'));
}
for my $path (@files) {
ok(defined $root->create($path, 'f'));
}
for my $path (@dirs, @files) {
ok($root->exists($path));
is_object_sane($root->lookup($path));
}
# Check to make sure child does essentially the same
ok(defined $root->child('foo'));
ok(!defined $root->child('foo2'));
for my $path (@dirs, @files) {
my $obj = $root->lookup($path);
is_object_sane($obj);
# properties
is_deeply([ $obj->properties ], [ qw/ basename dirname path object_type dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks / ]);
is_deeply([ $obj->settable_properties ], [ qw/ mode uid gid atime mtime / ]);
$obj->set_property('mode', 0700);
is($obj->get_property('mode') & 0777, 0700);
my $yesterday = time - 86400;
$obj->set_property('atime', $yesterday);
$obj->set_property('mtime', $yesterday);
is($obj->get_property('atime'), $yesterday);
is($obj->get_property('mtime'), $yesterday);
}
for my $path (@files) {
my ($mp) =
sort { -(length($a) <=> length($b)) }
grep { $root->normalize_path($path) =~ /^$_/ } $root->mounts;
my $real_path = $root->normalize_path($path);
$real_path =~ s[$mp][$mounts{$mp}/];
ok(-f $real_path);
my $obj = $root->lookup($path);
is_content_sane($obj);
is_content_writable($obj);
my $dir = $root->create("$mp/move_test", 'd');
is_content_mobile($obj, $dir);
$dir->remove('force');
}
for my $path (@dirs) {
my ($mp) =
sort { -(length($a) <=> length($b)) }
grep { $root->normalize_path($path) =~ /$_/ } $root->mounts;
my $real_path = $root->normalize_path($path);
$real_path =~ s[$mp][$mounts{$mp}/];
ok(-d $real_path);
my $obj = $root->lookup($path);
is_container_sane($obj);
next if $mp = $obj->path;
my $dir = $root->create("$mp/move_test", 'd');
is_container_mobile($obj, $dir);
$dir->remove('force');
}
is_glob_and_find_consistent($root);
for my $path (@dirs) {
my $obj = $root->lookup($path);
is_glob_and_find_consistent($obj);
}
}
rmtree([ qw( t/root t/root2 t/root3 t/root4 t/root5 ) ], 1);