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::Filesystem 'FS VFS :types :dirs cwd getcwd $Bin Bin';
use Badger::Test 
    tests => 59,
    debug => 'Badger::Filesystem',
    args  => \@ARGV;

our $TDIR = -d 't' ? FS->join_dir(qw(t filesystem)) : FS->directory;

# 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;
}



#-----------------------------------------------------------------------
# test $Bin from FindBin, and Bin() as directory wrapper around it
#-----------------------------------------------------------------------

ok( $Bin, "\$Bin is set to $Bin" );
my $bin = Bin;
ok( $bin, "\$bin is set to $bin" );
is( ref $bin, 'Badger::Filesystem::Directory', '$bin is a directory object' );



#-----------------------------------------------------------------------
# test Path(), File() and Directory()
#-----------------------------------------------------------------------

my $rel = File::Spec->catdir('foo', 'bar');
my $abs = File::Spec->rel2abs($rel, File::Spec->rootdir);
my $path = Path('/foo/bar');
ok( $path, 'created path using constructor sub' );
is( $path, $abs, 'matched path' );
is( Path('foo', 'bar'), $rel, 'path with separates' );

my $file = File('/foo/bar');
is( $file, $abs, 'absolute file' );
is( File('foo', 'bar'), $rel, 'relative file with separates' );

my $dir = Dir('/foo/bar');
ok( $dir, 'created dir using constructor sub' );
is( $dir, $abs, 'absolute dir' );
is( Dir('foo', 'bar'),  $rel, 'relative dir with separates' );

$dir = Directory('/foo/bar');
ok( $dir, 'created directory using constructor sub' );
is( $dir, $abs, 'absolute directory' );
is( Directory('foo', 'bar'), $rel, 'relative directory with separates' );


#-----------------------------------------------------------------------
# should also work without arguments as class name providers
#-----------------------------------------------------------------------

$path = Path->new('/foo/bar');
ok( $path, 'created path using constructor class' );

$file = File->new('/foo/bar');
ok( $file, 'created file using constructor class' );

$dir = Dir->new('/foo/bar');
ok( $dir, 'created dir using constructor class' );

$dir = Directory->new('/foo/bar');
ok( $dir, 'created directory using constructor class' );


#-----------------------------------------------------------------------
# and also via the FS alias for Badger::Filesystem
#-----------------------------------------------------------------------

$path = FS->path('/foo/bar');
ok( $path, 'created path using FS class' );

$file = FS->file('/foo/bar');
ok( $file, 'created file using FS class' );

$dir = FS->dir('/foo/bar');
ok( $dir, 'created dir using FS class' );

$dir = FS->directory->new('/foo/bar');
ok( $dir, 'created directory using FS class' );


#-----------------------------------------------------------------------
# test temp_directory() and temp_file()
#-----------------------------------------------------------------------

my $tmp = FS->temp_directory;
ok( $tmp, "got temp_directory() $tmp" );

$tmp = FS->temp_directory('foo', 'bar');
ok( $tmp, "got temp_directory() $tmp" );
$tmp = $tmp->file('badger_test1.tmp');
ok( $tmp->write("Hello World\n"), "wrote text to $tmp" );
ok( $tmp->delete, 'deleted temporary file' );

$tmp = FS->temp_file('badger_test2.tmp');
ok( $tmp, "got temp_file() $tmp" );
ok( $tmp->write("Hello World\n"), 'wrote text to tmp file' );
ok( $tmp->delete, 'deleted temporary file' );


#-----------------------------------------------------------------------
# we should also have a VFS reference defined and the module loaded
#-----------------------------------------------------------------------

is( VFS, 'Badger::Filesystem::Virtual', 'VFS is defined' );
ok( VFS->VERSION, 'VFS version is ' . VFS->VERSION );


#-----------------------------------------------------------------------
# check we can get root directory
#-----------------------------------------------------------------------

my $root = FS->root;
my $sub = $root->dir('foo', 'bar');
is( $root, File::Spec->rootdir, 'root dir' );
is( $sub, File::Spec->catfile('', 'foo', 'bar'), 'root dir relative' );


#-----------------------------------------------------------------------
# basic constructor test
#-----------------------------------------------------------------------

my $fs = FS->new;
ok( $fs, 'created a new filesystem' );

is( $fs->rootdir, ROOTDIR, 'root is ' . ROOTDIR );
is( $fs->updir, UPDIR, 'updir is ' . UPDIR );
is( $fs->curdir, CURDIR, 'curdir is ' . CURDIR );
is( $fs->separator, $PATHSEP, 'separator is ' . $PATHSEP );
ok( ! $fs->virtual, 'filesystem is not virtual' );


#-----------------------------------------------------------------------
# absolute and relative paths
#-----------------------------------------------------------------------

my $cwd = $fs->cwd;

$abs = $fs->absolute( File::Spec->catdir('wam', 'bam'));
is( $abs, File::Spec->catdir($cwd, 'wam', 'bam'), "absolute: $abs" );
ok( $fs->is_absolute($abs), 'path is absolute' );

$abs = $fs->absolute(['wam', 'bam']);
is( $abs, File::Spec->catdir($cwd, 'wam', 'bam'), "absolute: $abs" );
ok( $fs->is_absolute($abs), 'path is absolute' );

$rel = $fs->relative($abs);
is( $rel, File::Spec->catfile('wam', 'bam'), "relative: $rel" );
ok( $fs->is_relative($rel), 'path is relative' );


#-----------------------------------------------------------------------
# get some files
#-----------------------------------------------------------------------

my $file1 = $fs->file('file.t');
ok( $file1, 'fetched first file' );

my $file2 = $fs->file('filesystem.t');
ok( $file2, 'fetched second file' );

# both should have references to the same $fs filesystem
is( $file1->filesystem, $file2->filesystem, 
    'filesystems are both ' . $file1->filesystem );

is( $file1->filesystem, $fs, 
    'matches our filesystem: ' . $fs );


#-----------------------------------------------------------------------
# current working directory
#-----------------------------------------------------------------------

ok( cwd, 'got CWD: ' . cwd );
ok( getcwd, 'got getcwd: ' . getcwd );
$cwd = Cwd;
ok( $cwd, 'got Cwd' );
is( ref $cwd, 'Badger::Filesystem::Directory', 'got Cwd directory object' );
is( $cwd, Cwd, 'getcwd matches one way' );
is( $cwd, cwd, 'cwd matches the other way' );
is( $cwd, $fs->cwd, 'fs->cwd matches in the other other way' );


#-----------------------------------------------------------------------
# merge paths
#-----------------------------------------------------------------------

is( $fs->merge_paths('/path/one', '/path/two'), lp '/path/one/path/two', 'merged abs paths' );
is( $fs->merge_paths('/path/one', 'path/two'), lp '/path/one/path/two', 'merged abs/rel paths' );
is( $fs->merge_paths('path/one', 'path/two'), lp 'path/one/path/two', 'merged rel/rel paths' );