File: virtual.t

package info (click to toggle)
libbadger-perl 0.16-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,400 kB
  • sloc: perl: 11,004; makefile: 9
file content (193 lines) | stat: -rw-r--r-- 6,844 bytes parent folder | download
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' );