view release on metacpan or  search on metacpan

t/filesystem/virtual.t  view on Meta::CPAN

#============================================================= -*-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
#-----------------------------------------------------------------------