The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#============================================================= -*-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' );