#============================================================= -*-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 => 74,
    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('badger_test_p1', 'badger_test_p2');
my $abs = File::Spec->rel2abs($rel, File::Spec->rootdir);
my $path = Path('/badger_test_p1/badger_test_p2');
ok( $path, 'created path using constructor sub' );
is( $path, $abs, 'matched path' );
is( Path('badger_test_p1', 'badger_test_p2'), $rel, 'path with separates' );

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

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

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


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

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

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

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

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


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

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

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

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

$dir = FS->directory->new('/badger_test_p1/badger_test_p2');
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('badger_test_p1', 'badger_test_p2');
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('badger_test_p1', 'badger_test_p2');
is( $root, File::Spec->rootdir, 'root dir' );
is( $sub, File::Spec->catfile('', 'badger_test_p1', 'badger_test_p2'), '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' );

#-----------------------------------------------------------------------
# definitive* should not be applied multiple times when creating file
#-----------------------------------------------------------------------

package DFS;

use Badger::Class base => 'Badger::Filesystem';

sub definitive_write {
    my $self = shift;
    my $candidate = $self->SUPER::definitive_write(@_);
    return "$candidate-X";
}

{
    no warnings;             # avoid warnings about names used only once
    *definitive = \&definitive_write;
    *definitive_read = \&definitive_write;
}

package main;

my $dfs = DFS->new;
my $filename = 'foo-create.txt';
$path = "$TDIR/testfiles/$filename";
$abs = $dfs->absolute($path);
my $def = $dfs->definitive_write($path);
is($def, "$abs-X", 'definitive_write');
$file1 = $dfs->file($path);
ok($file1, "fetched $path");
is($file1->name, $filename, "file object has non-definitive name");
ok($file1->create, "call create on $path");
unless (ok(-e $def, "definitive file $path-X exists")) {
    my @files = grep { /$filename/ } FS->directory('testfiles')->files;
    fail("Instead found @files") if @files;
}
$file1->delete;

$filename = 'foo-touch.txt';
$path = "$TDIR/testfiles/$filename";
$abs = $dfs->absolute($path);
$def = $dfs->definitive_write($path);
is($def, "$abs-X", 'definitive_write');
$file1 = $dfs->file($path);
ok($file1, "fetched $path");
is($file1->name, $filename, "file object has non-definitive name");
ok($file1->touch, "call touch on $path");
unless (ok(-e $def, "definitive file $path-X exists")) {
    my @files = grep { /$filename/ } FS->directory('testfiles')->files;
    fail("Instead found @files") if @files;
}
$file1->delete;

$filename = 'foo-open.txt';
$path = "$TDIR/testfiles/$filename";
$abs = $dfs->absolute($path);
$def = $dfs->definitive_write($path);
is($def, "$abs-X", 'definitive_write');
$file1 = $dfs->file($path);
ok($file1, "fetched $path");
is($file1->name, $filename, "file object has non-definitive name");
my $fh = $file1->open('w');
ok($fh, "call open (for write) on $path");
$fh->close;
unless (ok(-e $def, "definitive file $path-X exists")) {
    my @files = grep { /$filename/ } FS->directory('testfiles')->files;
    fail("Instead found @files") if @files;
}
$file1->delete;