1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
|
#============================================================= -*-perl-*-
#
# t/filesystem/filesystem.t
#
# Test the Badger::Filesystem module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================
use lib qw( ./lib ../lib ../../lib );
use strict;
use warnings;
use File::Spec;
use Badger::Test
tests => 39,
debug => 'Badger::Filesystem::X Badger::Filesystem::Virtual',
args => \@ARGV;
use Badger::Filesystem 'FS';
use Badger::Filesystem::Virtual 'VFS';
# ugly hack to grok file separator on local filesystem
my $PATHSEP = File::Spec->catdir(('badger') x 2);
$PATHSEP =~ s/badger//g;
# convert unix-like paths into local equivalent
sub lp($) {
my $path = shift;
$path =~ s|/|$PATHSEP|g;
$path;
}
#-----------------------------------------------------------------------
# figure out where the t/filesystem/testfiles directory, depending on
# where this script is being run from.
#-----------------------------------------------------------------------
our $here = -d 't'
? FS->directory(qw(t filesystem))
: FS->Cwd;
our $tfdir = $here->dir('testfiles');
$tfdir->must_exist;
#-----------------------------------------------------------------------
# creating a VFS with no explicit root directory should use the real
# root directory, pretty much like a regular Badger::Filesystem
#-----------------------------------------------------------------------
my $fs = VFS->new;
ok( $fs, 'created a new virtual filesystem with default root' );
my $dir = $fs->dir($tfdir->absolute);
ok( $fs->dir($tfdir->absolute)->must_exist, 'got testfiles dir via default vfs' );
#-----------------------------------------------------------------------
# OK, so now let's try a VFS with our four virtual root directories
# The first, vdir_one, has just a 'foo' file. The second, vdir_two,
# has 'foo' and 'bar'. The third, vdir_three, has 'foo', 'bar' and 'baz'.
# We should be returned foo from the first, bar from the second and baz
# from the third. The fourth directory has a 'wibble' file and 'wobble'
# dir which we'll use later...
#-----------------------------------------------------------------------
my $vfs = VFS->new(
root => [ map { $tfdir->dir("vdir_$_") } qw( one two three four ) ]
);
ok( $vfs, 'created a new virtual filesystem with three roots' );
my $foo = $vfs->file('foo');
ok( $foo->exists, 'got foo' );
is( $foo->text, "This is foo in vdir_one\n", 'got foo from vdir_one' );
my $bar = $vfs->file('bar');
ok( $bar->exists, 'got bar' );
is( $bar->text, "This is bar in vdir_two\n", 'got bar from vdir_two' );
my $baz = $vfs->file('baz');
ok( $baz->exists, 'got baz' );
is( $baz->text, "This is baz in vdir_three\n", 'got baz from vdir_three' );
#-----------------------------------------------------------------------
# writing to a file should only happen in the first directory
#-----------------------------------------------------------------------
my $bam = $vfs->file('bam');
if ($bam->exists) {
ok($bam->delete, 'deleted existing bam file');
}
else {
pass('no existing bam file');
}
my $message = 'The random number is ' . int(rand(1000));
ok( $bam->write($message), 'wrote message to bam' );
ok( $bam->exists, 'bam exists' );
is( $bam->text, $message, "Read content: " . $message );
# check file exists in vdir_one using the *real* fs
my $bam_check = $tfdir->file( vdir_one => 'bam' );
ok( $bam_check->exists, 'independently checked bam exists' );
is( $bam_check->text, $message, "independently checked text: " . $message );
# delete it here and make sure VFS can't find it any more
ok( $bam_check->delete, 'deleted bam' );
ok( ! $bam_check->exists, 'bam no longer exists' );
ok( ! $bam->exists, 'VFS bam agrees' );
#-----------------------------------------------------------------------
# check we get a composite directory index
#-----------------------------------------------------------------------
is( join(', ', sort grep { ! /^\./ } $vfs->dir('/')->read), 'bar, baz, foo, wibble, wobble',
'got composite index' );
my @kids = $vfs->dir('/')->children;
foreach my $kid (@kids) {
next if $kid =~ /\.svn/;
ok( $kid->exists, "$kid exists" );
}
#-----------------------------------------------------------------------
# try dynamic root generators
#-----------------------------------------------------------------------
sub gen1 {
return [ map { $tfdir->dir("vdir_$_") } qw( one two ) ];
}
sub gen2 {
return [ map { $tfdir->dir("vdir_$_") } qw( three four ) ];
}
my $paths = [\&gen1, [\&gen2]];
$vfs = VFS->new( root => $paths );
ok( $vfs, 'created a new virtual filesystem with root generator' );
is( $vfs->file('foo')->text, "This is foo in vdir_one\n", 'got foo from dynamic vdir_one' );
is( $vfs->file('bar')->text, "This is bar in vdir_two\n", 'got bar from dynamic vdir_two' );
is( $vfs->file('baz')->text, "This is baz in vdir_three\n", 'got baz from dynamic vdir_three' );
# changing the path shouldn't make any difference because we didn't set the
# dynamic flag.
@$paths = [\&gen2, \&gen1];
is( $vfs->file('foo')->text, "This is foo in vdir_one\n", 'got foo from dynamic vdir_one' );
unshift(@$paths, $tfdir->dir('vdir_two'));
is( $vfs->file('foo')->text, "This is foo in vdir_one\n", 'got foo from dynamic vdir_one again' );
$paths = [\&gen1, \&gen2];
$vfs = VFS->new( root => $paths, dynamic => 1 );
ok( $vfs, 'created a new dynamic virtual filesystem with root generator' );
is( $vfs->file('foo')->text, "This is foo in vdir_one\n", 'got foo from dynamic vdir_one yet again' );
# now that the dynamic flag is set, we can change the path
@$paths = [\&gen2, \&gen1];
is( $vfs->file('foo')->text, "This is foo in vdir_three\n", 'got foo from dynamic vdir_three' );
unshift(@$paths, $tfdir->dir('vdir_two'));
is( $vfs->file('foo')->text, "This is foo in vdir_two\n", 'got foo from dynamic vdir_two' );
#-----------------------------------------------------------------------
# test a purely virtual file system - there's no real directories
# behind this (unless you happen to have a directory on your system
# matching /path/to/my/web/pages but I suspect that's unlikely!)
#-----------------------------------------------------------------------
$vfs = VFS->new(
root => '/path/to/my/web/pages',
);
ok( $vfs, 'created filesystem with virtual root' );
my $file1 = $vfs->file('foo', 'bar');
is( $file1->absolute, lp '/foo/bar', 'absolute foo bar in virtual root fs' );
$file1 = $vfs->file('/foo/bar');
is( $file1->absolute, lp '/foo/bar', 'absolute /foo/bar in virtual root fs' );
is( $file1->definitive, lp '/path/to/my/web/pages/foo/bar', 'definitive path adds root' );
ok( $vfs->virtual, 'filesystem is virtual' );
|