The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# Formal testing for File::Flat

use strict;
use File::Spec::Functions ':ALL';
BEGIN {
	$|  = 1;
	$^W = 1;
}

use File::Copy   'copy';
use File::Remove 'remove';
use File::Find   'find';

# If we are root, some things we WANT to fail won't,
# and we'll have to skip some tests.
use vars qw{$root $win32};
BEGIN {
	$root  = ($> == 0) ? 1 : 0;
	$win32 = ($^O eq 'MSWin32') ? 1 : 0;
}

# cygwin permissions are insane, so lets treat everyone like
# root and skip all the relevant tests.
# we ALSO want to skip all the tests (mostly related to canExecute)
# that fail on Win32.
BEGIN {
	if ( $^O eq 'cygwin' ) {
		$root  = 1;
		$win32 = 1;
	}
}

use Test::More tests => 269;

# Set up any needed globals
use vars qw{$loaded $ci $bad};
use vars qw{$content_string @content_array $content_length};
use vars qw{$curdir %f};
BEGIN {
	$loaded = 0;
	$| = 1;
	$content_string = "one\ntwo\nthree\n\n";
	@content_array  = ( 'one', 'two', 'three', '' );
	$content_length = length $content_string;

	# Define all the paths we are going to need in advance
	$curdir = curdir();
	%f = (
		null           => catfile( $curdir, 'null'      ),
		something      => catfile( $curdir, 'something' ),

		rwx            => catfile( $curdir, '0000'   ),
		Rwx            => catfile( $curdir, '0400'   ),
		rWx            => catfile( $curdir, '0200'   ),
		rwX            => catfile( $curdir, '0100'   ),
		RWx            => catfile( $curdir, '0600'   ),
		RwX            => catfile( $curdir, '0500'   ),
		rWX            => catfile( $curdir, '0300'   ),
		RWX            => catfile( $curdir, '0700'   ),
		gooddir        => catdir(  $curdir, 'gooddir' ),
		baddir         => catdir(  $curdir, 'baddir'  ),

		ff_handle      => catfile( $curdir, 't', 'ff_handle'  ),
		ff_binary      => catfile( $curdir, 't', 'ff_binary'  ),
		ff_text        => catfile( $curdir, 't', 'ff_text'    ),
		ff_content     => catfile( $curdir, 't', 'ff_content' ),

		ff_content2    => catfile( $curdir, 'ff_content2'   ),
		a_ff_text3     => catfile( $curdir, 'a', 'ff_text3' ),
		abcde_ff_text3 => catfile( $curdir, 'a', 'b', 'c', 'd', 'e', 'ff_text3' ),
		abdde_ff_text3 => catfile( $curdir, 'a', 'b', 'd', 'd', 'e', 'ff_text3' ),
		abc            => catdir(  $curdir, 'a', 'b', 'c' ),
		abd            => catdir(  $curdir, 'a', 'b', 'd' ),
		a              => catdir(  $curdir, 'a' ),
		b              => catdir(  $curdir, 'b' ),

		moved_1        => catfile( $curdir, 'moved_1' ),
		moved_2        => catfile( $curdir, 'b', 'c', 'd', 'e', 'moved_2' ),		

		write_1        => catfile( $curdir, 'write_1' ),
		write_2        => catfile( $curdir, 'write_2' ),
		write_3        => catfile( $curdir, 'write_3' ),
		write_4        => catfile( $curdir, 'write_4' ),
		write_5        => catfile( $curdir, 'write_5' ),
		write_6        => catfile( $curdir, 'write_6' ),

		over_1         => catfile( $curdir, 'over_1' ),
		over_2         => catfile( $curdir, 'over_2' ),
		over_3         => catfile( $curdir, 'over_3' ),
		over_4         => catfile( $curdir, 'over_4' ),

		append_1       => catfile( $curdir, 'append_1' ),
		append_2       => catfile( $curdir, 'append_2' ),
		append_3       => catfile( $curdir, 'append_3' ),
		append_4       => catfile( $curdir, 'append_4' ),

		size_1         => catfile( $curdir, 'size_1' ),
		size_2         => catfile( $curdir, 'size_2' ),
		size_3         => catfile( $curdir, 'size_3' ),

		trunc_1        => catfile( $curdir, 'trunc_1' ),

		prune          => catdir(  $curdir, 'prunedir' ),
		prune_1        => catdir(  $curdir, 'prunedir', 'single' ),
		prune_2        => catdir(  $curdir, 'prunedir', 'multiple', 'lots', 'of', 'dirs' ),
		prune_2a       => catdir(  $curdir, 'prunedir', 'multiple' ),
		prune_3        => catdir(  $curdir, 'prunedir', 'onlyone', 'thisone' ),
		prune_4        => catdir(  $curdir, 'prunedir', 'onlyone', 'notthis' ),
		prune_4a       => catdir(  $curdir, 'prunedir', 'onlyone' ),
		prune_5        => catdir(  $curdir, 'prunedir', 'onlyone', 'notthis', 'orthis' ),
		
		remove_prune_1 => catfile( $curdir, 'prunedir', 'remove', 'prune_1' ),
		remove_prune_2 => catfile( $curdir, 'prunedir', 'remove', 'prune_2' ),
		remove_prune_3 => catfile( $curdir, 'prunedir', 'remove', 'prune_3' ),
		remove_prune_4 => catfile( $curdir, 'prunedir', 'remove', 'prune_4' ),
		remove_prune_5 => catfile( $curdir, 'prunedir', 'remove', 'prune_5' ),
		remove_prune_6 => catfile( $curdir, 'prunedir', 'remove', 'prune_6' ),
		);

	# Avoid some 'only used once' warnings
	$File::Flat::errstr = $File::Flat::errstr;
	$File::Flat::AUTO_PRUNE = $File::Flat::AUTO_PRUNE;
}		

# Convenience functions to avoid system calls
sub touch_test_file($) {
	# Do the 'touch' part
	my $file = catfile( $curdir, $_[0] );
	open FILE, ">>$file" or return undef;
	close FILE;

	# And now the chmod part
	my $mask = oct($_[0]);
	chmod $mask, $file or return undef;

	1;
}

sub chmod_R($$) {
    my($mask, $dir) = @_;
    chmod $mask, $dir;
    find( sub { chmod $mask, $File::Find::name }, $dir );
}

# Check their perl version, and that modules are installed
ok( $] >= 5.005, "Your perl is new enough" );
use_ok( 'File::Flat' );




# Check for the three files that should already exist
ok( -f $f{ff_text},    'ff_text exists'    );
ok( -f $f{ff_binary},  'ff_binary exists'  );
ok( -f $f{ff_content}, 'ff_content exists' );

# Create the files for the file test section
touch_test_file('0000') or die "Failed to create file we can do anything to";
touch_test_file('0400') or die "Failed to create file we can only read";
touch_test_file('0200') or die "Failed to create file we can only write";
touch_test_file('0100') or die "Failed to create file we can only execute";
touch_test_file('0600') or die "Failed to create file we can read and write";
touch_test_file('0500') or die "Failed to create file we can read and execute";
touch_test_file('0300') or die "Failed to create file we can write and execute";
touch_test_file('0700') or die "Failed to create file we can read, write and execute";

unless ( chmod 0777, $curdir ) {
	die "Failed to set current directory to mode 777";
}
unless ( -e $f{gooddir} ) {
	unless ( mkdir $f{gooddir}, 0755 ) {
		die "Failed to create mode 0755 directory";
	}
}
unless ( -e $f{baddir} ) {
	unless ( mkdir $f{baddir}, 0000 ) {
		die "Failed to create mode 0000 directory";
	}
}

# We are also going to use a file called "./null" to represent
# a file that doesn't exist.



### Test Section 1
# Here we will test all the static methods that are handled directly, and
# not passed on to the object form of the methods.

# Test the error message handling
my $error_message = 'foo';
my $rv = File::Flat->_error( $error_message );
ok( ! defined $rv, "->_error returns undef" );
ok( $File::Flat::errstr eq $error_message, "->_error sets error message" );
ok( File::Flat->errstr eq $error_message, "->errstr retrieves error message" );

# Test the static ->exists method
ok( ! File::Flat->exists( $f{null} ), "Static ->exists doesn't see missing file" );
ok( File::Flat->exists( $f{rwx} ), "Static ->exists sees mode 000 file" );
ok( File::Flat->exists( $f{Rwx} ), "Static ->exists sees mode 400 file" );
ok( File::Flat->exists( $f{RWX} ), "Static ->exists sees mode 700 file" );
ok( File::Flat->exists( $curdir ), "Static ->exists sees . directory" );
ok( File::Flat->exists( $f{baddir} ), "Static ->exists sees mode 000 directory" );

# Test the static ->isaFile method
ok( ! File::Flat->isaFile( $f{null} ), "Static ->isaFile returns false for missing file" );
ok( File::Flat->isaFile( $f{rwx} ), "Static ->isaFile returns true for mode 000 file" );
ok( File::Flat->isaFile( $f{RWX} ), "Static ->isaFile returns true for mode 700 file" );
ok( ! File::Flat->isaFile( $curdir ), "Static ->isaFile returns false for current directory" );
ok( ! File::Flat->isaFile( $f{gooddir} ), "Static ->isaFile returns false for subdirectory" );

# Test the static ->isaDirectory method
ok( ! File::Flat->isaDirectory( $f{null} ), "Static ->isaDirectory returns false for missing directory" );
ok( ! File::Flat->isaDirectory( $f{rwx} ), "Static ->isaDirectory returns false for mode 000 file" );
ok( ! File::Flat->isaDirectory( $f{RWX} ), "Static ->isaDirectory returns false for mode 700 file" );
ok( File::Flat->isaDirectory( $curdir ), "Static ->isaDirectory returns true for current directory" );
ok( File::Flat->isaDirectory( $f{gooddir} ), "Static ->isaDirectory returns true for readable subdirectory" );
ok( File::Flat->isaDirectory( $f{baddir} ), "Static ->isaDirectory return true for unreadable subdirectory" );

# Test the static ->canRead method
ok( ! File::Flat->canRead( $f{null} ), "Static ->canRead returns false for missing file" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canRead( $f{rwx} ), "Static ->canRead returns false for mode 000 file" );
}
ok( File::Flat->canRead( $f{Rwx} ), "Static ->canRead returns true for mode 400 file" );
SKIP: {
	skip "Skipping tests known to fail for root", 2 if $root;
	ok( ! File::Flat->canRead( $f{rWx} ), "Static ->canRead returns false for mode 200 file" );
	ok( ! File::Flat->canRead( $f{rwX} ), "Static ->canRead returns false for mode 100 file" );
}
ok( File::Flat->canRead( $f{RWx} ), "Static ->canRead returns true for mode 500 file" );
ok( File::Flat->canRead( $f{RwX} ), "Static ->canRead returns true for mode 300 file" );
ok( File::Flat->canRead( $f{RWX} ), "Static ->canRead returns true for mode 700 file" );
ok( File::Flat->canRead( $curdir ), "Static ->canRead returns true for current directory" );
ok( File::Flat->canRead( $f{gooddir} ), "Static ->canRead returns true for readable subdirectory" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canRead( $f{baddir} ), "Static ->canRead returns false for unreadable subdirectory" );
}


# Test the static ->canWrite method
ok( File::Flat->canWrite( $f{null} ), "Static ->canWrite returns true for missing, creatable, file" );
SKIP: {
	skip "Skipping tests known to fail for root", 2 if $root;
	ok( ! File::Flat->canWrite( $f{rwx} ), "Static ->canWrite returns false for mode 000 file" );
	ok( ! File::Flat->canWrite( $f{Rwx} ), "Static ->canWrite returns false for mode 400 file" );
}
ok( File::Flat->canWrite( $f{rWx} ), "Static ->canWrite returns true for mode 200 file" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canWrite( $f{rwX} ), "Static ->canWrite returns false for mode 100 file" );
}
ok( File::Flat->canWrite( $f{RWx} ), "Static ->canWrite returns true for mode 500 file" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canWrite( $f{RwX} ), "Static ->canWrite returns false for mode 300 file" );
}
ok( File::Flat->canWrite( $f{RWX} ), "Static ->canWrite returns true for mode 700 file" );
ok( File::Flat->canWrite( $curdir ), "Static ->canWrite returns true for current directory" );
ok( File::Flat->canWrite( $f{gooddir} ), "Static ->canWrite returns true for writable subdirectory" );
SKIP: {
	skip "Skipping tests known to fail for root", 2 if $root;
	ok( ! File::Flat->canWrite( $f{baddir} ), "Static ->canWrite returns false for unwritable subdirectory" );
	ok( ! File::Flat->canWrite( catfile($f{baddir}, 'file') ), "Static ->canWrite returns false for missing, non-creatable file" );
}

# Test the static ->canReadWrite method
ok( ! File::Flat->canReadWrite( $f{null} ), "Static ->canReadWrite returns false for missing file" );
SKIP: {
	skip "Skipping tests known to fail for root", 4 if $root;
	ok( ! File::Flat->canReadWrite( $f{rwx} ), "Static ->canReadWrite returns false for mode 000 file" );
	ok( ! File::Flat->canReadWrite( $f{Rwx} ), "Static ->canReadWrite returns false for mode 400 file" );
	ok( ! File::Flat->canReadWrite( $f{rWx} ), "Static ->canReadWrite returns false for mode 200 file" );
	ok( ! File::Flat->canReadWrite( $f{rwX} ), "Static ->canReadWrite returns false for mode 100 file" );
}
ok( File::Flat->canReadWrite( $f{RWx} ), "Static ->canReadWrite returns true for mode 500 file" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canReadWrite( $f{RwX} ), "Static ->canReadWrite returns false for mode 300 file" );
}
ok( File::Flat->canReadWrite( $f{RWX} ), "Static ->canReadWrite returns true for mode 700 file" );
ok( File::Flat->canReadWrite( $curdir ), "Static ->canReadWrite returns true for current directory" );
ok( File::Flat->canReadWrite( $f{gooddir} ), "Static ->canReadWrite returns true for readwritable subdirectory" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canReadWrite( $f{baddir} ), "Static ->canReadWrite returns false for unreadwritable subdirectory" );
}

# Test the static ->canExecute method
SKIP: {
	skip( "Skipping tests known to falsely fail on Win32", 11 ) if $win32;

	ok( ! File::Flat->canExecute( $f{null} ), "Static ->canExecute returns false for missing file" );
	ok( ! File::Flat->canExecute( $f{rwx} ), "Static ->canExecute returns false for mode 000 file" );
	ok( ! File::Flat->canExecute( $f{Rwx} ), "Static ->canExecute returns false for mode 400 file" );
	ok( ! File::Flat->canExecute( $f{rWx} ), "Static ->canExecute returns false for mode 200 file" );
	ok( File::Flat->canExecute( $f{rwX} ), "Static ->canExecute returns true for mode 100 file" );
	ok( ! File::Flat->canExecute( $f{RWx} ), "Static ->canExecute returns false for mode 500 file" );
	ok( File::Flat->canExecute( $f{RwX} ), "Static ->canExecute returns true for mode 300 file" );
	ok( File::Flat->canExecute( $f{RWX} ), "Static ->canExecute returns true for mode 700 file" );
	ok( File::Flat->canExecute( $curdir ), "Static ->canExecute returns true for current directory" );
	ok( File::Flat->canExecute( $f{gooddir} ), "Static ->canExecute returns true for executable subdirectory" );

	skip( "Skipping tests known to falsely fail for root", 1 ) if $root;
	ok( ! File::Flat->canExecute( $f{baddir} ), "Static ->canExecute returns false for unexecutable subdirectory" );
}

# Test the static ->canOpen method
ok( ! File::Flat->canOpen( $f{null} ), "Static ->canOpen returns false for missing file" );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! File::Flat->canOpen( $f{rwx} ), "Static ->canOpen returns false for mode 000 file" );
}
ok( File::Flat->canOpen( $f{Rwx} ), "Static ->canOpen returns true for mode 400 file" );
SKIP: {
	skip "Skipping tests known to fail for root", 2 if $root;
	ok( ! File::Flat->canOpen( $f{rWx} ), "Static ->canOpen returns false for mode 200 file" );
	ok( ! File::Flat->canOpen( $f{rwX} ), "Static ->canOpen returns false for mode 100 file" );
}
ok( File::Flat->canOpen( $f{RWx} ), "Static ->canOpen returns true for mode 500 file" );
ok( File::Flat->canOpen( $f{RwX} ), "Static ->canOpen returns true for mode 300 file" );
ok( File::Flat->canOpen( $f{RWX} ), "Static ->canOpen returns true for mode 700 file" );
ok( ! File::Flat->canOpen( $curdir ), "Static ->canOpen returns false for current directory" );
ok( ! File::Flat->canOpen( $f{gooddir} ), "Static ->canOpen returns false for readable subdirectory" );
ok( ! File::Flat->canOpen( $f{baddir} ), "Static ->canOpen returns false for unreadable subdirectory" );

# Test the existance of normal and/or binary files
ok( ! File::Flat->isText( $f{null} ), "Static ->isText returns false for missing file" );
ok( ! File::Flat->isText( $f{ff_binary} ), "Static ->isText returns false for binary file" );
ok( File::Flat->isText( $f{ff_text} ), "Static ->isText returns true for text file" );
ok( ! File::Flat->isText( $f{gooddir} ), "Static ->isText returns false for good subdirectory" );
ok( ! File::Flat->isText( $f{baddir} ), "Static ->isText returns false for bad subdirectory" );
ok( ! File::Flat->isBinary( $f{null} ), "Static ->isBinary returns false for missing file" );
ok( File::Flat->isBinary( $f{ff_binary} ), "Static ->isBinary returns true for binary file" );
ok( ! File::Flat->isBinary( $f{ff_text} ), "Static ->isBinary returns false for text file" );
ok( ! File::Flat->isBinary( $f{gooddir} ), "Static ->isBinary return false for good subdirectory" );
ok( ! File::Flat->isBinary( $f{baddir} ), "Static ->isBinary returns false for bad subdirectory" );

my %handle = ();

# Do open handle methods return false for bad values
$handle{generic} = File::Flat->open( $f{null} );
$handle{readhandle} = File::Flat->open( $f{null} );
$handle{writehandle} = File::Flat->open( $f{null} );
$handle{appendhandle} = File::Flat->open( $f{null} );
$handle{readwritehandle} = File::Flat->open( $f{null} );
ok( ! defined $handle{generic}, "Static ->open call returns undef on bad file name" );
ok( ! defined $handle{readhandle}, "Static ->getReadHandle returns undef on bad file name" );
ok( ! defined $handle{writehandle}, "Static ->getWriteHandle returns undef on bad file name" );
ok( ! defined $handle{appendhandle}, "Static ->getAppendHandle returns undef on bad file name" );
ok( ! defined $handle{readwritehandle}, "Static ->getReadWriteHandle returns undef on bad file name" );

# Do the open methods at least return a file handle
copy( $f{ff_text}, $f{ff_handle} ) or die "Failed to copy file in preperation for test";
$handle{generic}         = File::Flat->open( $f{ff_handle} );
$handle{readhandle}      = File::Flat->getReadHandle( $f{ff_handle} );
$handle{writehandle}     = File::Flat->getWriteHandle( $f{ff_handle} );
$handle{appendhandle}    = File::Flat->getAppendHandle( $f{ff_handle} );
$handle{readwritehandle} = File::Flat->getReadWriteHandle( $f{ff_handle} );
isa_ok( $handle{generic},         'IO::File' ); # Static ->open call returns IO::File object
isa_ok( $handle{readhandle},      'IO::File' ); # Static ->getReadHandle returns IO::File object
isa_ok( $handle{writehandle},     'IO::File' ); # Static ->getWriteHandle returns IO::File object
isa_ok( $handle{appendhandle},    'IO::File' ); # Static ->getAppendHandle returns IO::File object
isa_ok( $handle{readwritehandle}, 'IO::File' ); # Static ->getReadWriteHandle returns IO::File object






# Test the static ->copy method
ok( ! defined File::Flat->copy(), '->copy() returns error' );
ok( ! defined File::Flat->copy( $f{ff_content} ), '->copy( file ) returns error' );

$rv = File::Flat->copy( $f{ff_content}, $f{ff_content2} );
ok( $rv, "Static ->copy returns true correctly for same directory copy" );
ok( -e $f{ff_content2}, "Static ->copy actually created the file for same directory copy" );
ok( check_content_file( $f{ff_content2} ), "Static ->copy copies the file without breaking it" );

$rv = File::Flat->copy( $f{ff_text}, $f{a_ff_text3} );
ok( $rv, "Static ->copy returns true correctly for single sub-directory copy" );
ok( -e $f{a_ff_text3}, "Static ->copy actually created the file for single sub-directory copy" );

$rv = File::Flat->copy( $f{ff_text}, $f{abcde_ff_text3} );
ok( $rv, "Static ->copy returns true correctly for multiple sub-directory copy" );
ok( -e $f{abcde_ff_text3}, "Static ->copy actually created the file for multiple sub-directory copy" );

$rv = File::Flat->copy( $f{null}, $f{something} );
ok( ! $rv, "Static ->copy return undef when file does not exist" );

# Directory copying
$rv = File::Flat->copy( $f{abc}, $f{abd} );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( $rv, '->copy( dir, dir ) returns true' );
}
ok( -d $f{abd}, '->copy( dir, dir ): New dir exists' );
ok( -f $f{abdde_ff_text3}, '->copy( dir, dir ): Files within directory were copied' );

# Test the static ->move method
$rv = File::Flat->move( $f{abcde_ff_text3}, $f{moved_1} );
ok( $rv, "Static ->move for move to existing directory returns true " );
ok( ! -e $f{abcde_ff_text3}, "Static ->move for move to existing directory actually removes the old file" );
ok( -e $f{moved_1}, "Static ->move for move to existing directory actually creates the new file" );

$rv = File::Flat->move( $f{ff_content2}, $f{moved_2} );
ok( $rv, "Static ->move for move to new directory returns true " );
ok( ! -e $f{ff_content2}, "Static ->move for move to new directory actually removes the old file" );
ok( -e $f{moved_2}, "Static ->move for move to new directory actually creates the new file" );
ok( check_content_file( $f{moved_2} ), "Static ->move moved the file without breaking it" );






# Test the static ->slurp method
ok( check_content_file( $f{ff_content} ), "Content tester works" );
my $content = File::Flat->slurp();
ok( ! defined $content, "Static ->slurp returns error on no arguments" );
$content = File::Flat->slurp( $f{null} );
ok( ! defined $content, "Static ->slurp returns error on bad file" );
$content = File::Flat->slurp( $f{ff_content} );
ok( defined $content, "Static ->slurp returns defined" );
ok( defined $content, "Static ->slurp returns something" );
ok( UNIVERSAL::isa( $content, 'SCALAR' ), "Static ->slurp returns a scalar reference" );
ok( length $$content, "Static ->slurp returns content" );
ok( $$content eq $content_string, "Static ->slurp returns the correct file contents" );

# Test the static ->read
$content = File::Flat->read();
ok( ! defined $content, "Static ->read returns error on no arguments" );
$content = File::Flat->read( $f{null} );
ok( ! defined $content, "Static ->read returns error on bad file" );
$content = File::Flat->read( $f{ff_content} );
ok( defined $content, "Static ->read doesn't error on good file" );
ok( $content, "Static ->read returns true on good file" );
ok( ref $content, "Static ->read returns a reference on good file" );
ok( UNIVERSAL::isa( $content, 'ARRAY' ), "Static ->read returns an array ref on good file" );
ok( scalar @$content == 4, "Static ->read returns the correct length of data" );
my $matches = (
	$content->[0] eq 'one'
	and $content->[1] eq 'two'
	and $content->[2] eq 'three'
	and $content->[3] eq ''
	) ? 1 : 0;
ok( $matches, "Static ->read returns the expected content" );

# And again in an array context
my @content = File::Flat->read();
ok( ! scalar @content, "Static ->read (array context) returns error on no arguments" );
@content = File::Flat->read( $f{null} );
ok( ! scalar @content, "Static ->read (array context) returns error on bad file" );
@content = File::Flat->read( $f{ff_content} );
ok( scalar @content, "Static ->read (array context) doesn't error on good file" );
ok( scalar @content == 4, "Static ->read (array context) returns the correct length of data" );
$matches = (
	$content[0] eq 'one'
	and $content[1] eq 'two'
	and $content[2] eq 'three'
	and $content[3] eq ''
	) ? 1 : 0;
ok( $matches, "Static ->read (array context) returns the expected content" );





# Test the many and varies write() options.
ok( ! File::Flat->write(), "->write() fails correctly" );
ok( ! File::Flat->write( $f{write_1} ), "->write( file ) fails correctly" );
ok( ! -e $f{write_1}, "->write( file ) doesn't actually create a file" );

$rv = File::Flat->write( $f{write_1}, $content_string );
ok( $rv, "->File::Flat->write( file, string ) returns true" );
ok( -e $f{write_1}, "->write( file, string ) actually creates a file" );
ok( check_content_file( $f{write_1} ), "->write( file, string ) writes the correct content" );

$rv = File::Flat->write( $f{write_2}, $content_string );
ok( $rv, "->File::Flat->write( file, string_ref ) returns true" );
ok( -e $f{write_2}, "->write( file, string_ref ) actually creates a file" );
ok( check_content_file( $f{write_2} ), "->write( file, string_ref ) writes the correct content" );

$rv = File::Flat->write( $f{write_3}, \@content_array );
ok( $rv, "->write( file, array_ref ) returns true" );
ok( -e $f{write_3}, "->write( file, array_ref ) actually creates a file" );
ok( check_content_file( $f{write_3} ), "->write( file, array_ref ) writes the correct content" );

# Repeat with a handle first argument
my $handle = File::Flat->getWriteHandle( $f{write_4} );
ok( ! File::Flat->write( $handle ), "->write( handle ) fails correctly" );
ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
$rv = File::Flat->write( $handle, $content_string );
$handle->close();
ok( $rv, "->write( handle, string ) returns true" );
ok( -e $f{write_4}, "->write( handle, string ) actually creates a file" );
ok( check_content_file( $f{write_1} ), "->write( handle, string ) writes the correct content" );

$handle = File::Flat->getWriteHandle( $f{write_5} );
ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
$rv = File::Flat->write( $handle, $content_string );
$handle->close();
ok( $rv, "->File::Flat->write( handle, string_ref ) returns true" );
ok( -e $f{write_5}, "->write( handle, string_ref ) actually creates a file" );
ok( check_content_file( $f{write_5} ), "->write( handle, string_ref ) writes the correct content" );

$handle = File::Flat->getWriteHandle( $f{write_6} );
ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
$rv = File::Flat->write( $handle, \@content_array );
$handle->close();
ok( $rv, "->File::Flat->write( handle, array_ref ) returns true" );
ok( -e $f{write_6}, "->write( handle, array_ref ) actually creates a file" );
ok( check_content_file( $f{write_6} ), "->write( handle, array_ref ) writes the correct content" );






# Check the ->overwrite method
ok( ! File::Flat->overwrite(), "->overwrite() fails correctly" );
ok( ! File::Flat->overwrite( $f{over_1} ), "->overwrite( file ) fails correctly" );
ok( ! -e $f{over_1}, "->overwrite( file ) doesn't actually create a file" );

$rv = File::Flat->overwrite( $f{over_1}, $content_string );
ok( $rv, "->File::Flat->overwrite( file, string ) returns true" );
ok( -e $f{over_1}, "->overwrite( file, string ) actually creates a file" );
ok( check_content_file( $f{over_1} ), "->overwrite( file, string ) writes the correct content" );

$rv = File::Flat->overwrite( $f{over_2}, $content_string );
ok( $rv, "->File::Flat->overwrite( file, string_ref ) returns true" );
ok( -e $f{over_2}, "->overwrite( file, string_ref ) actually creates a file" );
ok( check_content_file( $f{over_2} ), "->overwrite( file, string_ref ) writes the correct content" );

$rv = File::Flat->overwrite( $f{over_3}, \@content_array );
ok( $rv, "->overwrite( file, array_ref ) returns true" );
ok( -e $f{over_3}, "->overwrite( file, array_ref ) actually creates a file" );
ok( check_content_file( $f{over_3} ), "->overwrite( file, array_ref ) writes the correct content" );

# Check actually overwriting a file
ok ( File::Flat->copy( $f{ff_text}, $f{over_4} ), "Preparing for overwrite test" );
$rv = File::Flat->overwrite( $f{over_4}, \$content_string );
ok( $rv, "->overwrite( file, array_ref ) returns true" );
ok( -e $f{over_4}, "->overwrite( file, array_ref ) actually creates a file" );
ok( check_content_file( $f{over_4} ), "->overwrite( file, array_ref ) writes the correct content" );





# Check the basics of the ->remove method
ok( ! File::Flat->remove(), "->remove() correctly return an error" );
ok( ! File::Flat->remove( $f{null} ), "->remove( file ) returns an error for a nonexistant file" );
ok( File::Flat->remove( $f{over_4} ), "->remove( file ) returns true for existing file" );
ok( ! -e $f{over_4}, "->remove( file ) actually removes the file" );
ok( File::Flat->remove( $f{a} ), "->remove( directory ) returns true for existing directory" );
ok( ! -e $f{a}, "->remove( directory ) actually removes the directory" );





# Check the append method
ok( ! File::Flat->append(), "->append() correctly returns an error" );
ok( ! File::Flat->append( $f{append_1} ), "->append( file ) correctly returns an error" );
ok( ! -e $f{append_1}, "->append( file ) doesn't actually create a file" );

$rv = File::Flat->append( $f{append_1}, $content_string );
ok( $rv, "->File::Flat->append( file, string ) returns true" );
ok( -e $f{append_1}, "->append( file, string ) actually creates a file" );
ok( check_content_file( $f{append_1} ), "->append( file, string ) writes the correct content" );

$rv = File::Flat->append( $f{append_2}, $content_string );
ok( $rv, "->File::Flat->append( file, string_ref ) returns true" );
ok( -e $f{append_2}, "->append( file, string_ref ) actually creates a file" );
ok( check_content_file( $f{append_2} ), "->append( file, string_ref ) writes the correct content" );

$rv = File::Flat->append( $f{append_3}, \@content_array );
ok( $rv, "->append( file, array_ref ) returns true" );
ok( -e $f{append_3}, "->append( file, array_ref ) actually creates a file" );
ok( check_content_file( $f{append_3} ), "->append( file, array_ref ) writes the correct content" );

# Now let's try an actual append
ok( File::Flat->append( $f{append_4}, "one\ntwo\n" ), "Preparing for real append" );
$rv = File::Flat->append( $f{append_4}, "three\n\n" );
ok( $rv, "->append( file, array_ref ) for an actual append returns true" );
ok( -e $f{append_4}, "->append( file, array_ref ): File still exists" );
ok( check_content_file( $f{append_4} ), "->append( file, array_ref ) results in the correct file contents" );





# Test the ->fileSize method
ok( File::Flat->write( $f{size_1}, 'abcdefg' )
	&& File::Flat->write( $f{size_2}, join '', ( 'd' x 100000 ) )
	&& File::Flat->write( $f{size_3}, '' ),
	"Preparing for file size tests"
	);
ok( ! defined File::Flat->fileSize(), "->fileSize() correctly returns error" );
ok( ! defined File::Flat->fileSize( $f{null} ), '->fileSize( file ) returns error for nonexistant file' );
ok( ! defined File::Flat->fileSize( $f{a} ), '->fileSize( directory ) returns error' );
$rv = File::Flat->fileSize( $f{size_1} );
ok( defined $rv, "->fileSize( file ) returns true for small file" );
ok( $rv == 7, "->fileSize( file ) returns the correct size for small file" );
$rv = File::Flat->fileSize( $f{size_2} );
ok( defined $rv, "->fileSize( file ) returns true for big file" );
ok( $rv == 100000, "->fileSize( file ) returns the correct size for big file" );
$rv = File::Flat->fileSize( $f{size_3} );
ok( defined $rv, "->fileSize( file ) returns true for empty file" );
ok( $rv == 0, "->fileSize( file ) returns the correct size for empty file" );







# Test the ->truncate method. Use the append files
ok( ! defined File::Flat->truncate(), '->truncate() correctly returns error' );
SKIP: {
	skip "Skipping tests known to fail for root", 1 if $root;
	ok( ! defined File::Flat->truncate( $f{rwx} ), '->truncate( file ) returns error when no permissions' );
}
ok( ! defined File::Flat->truncate( './b' ), '->truncate( directory ) returns error' );
$rv = File::Flat->truncate( $f{trunc_1} );
ok( $rv, '->truncate( file ) returns true for non-existant file' );
ok( -e $f{trunc_1}, '->truncate( file ) creates new file' );
ok( File::Flat->fileSize( $f{trunc_1} ) == 0, '->truncate( file ) creates file of 0 bytes' );

$rv = File::Flat->truncate( $f{append_1} );
ok( $rv, '->truncate( file ) returns true for existing file' );
ok( -e $f{append_1}, '->truncate( file ): File still exists' );
ok( File::Flat->fileSize( $f{append_1} ) == 0, '->truncate( file ) truncates to 0 bytes' );

$rv = File::Flat->truncate( $f{append_2}, 0 );
ok( $rv, '->truncate( file, 0 ) returns true for existing file' );
ok( -e $f{append_2}, '->truncate( file, 0 ): File still exists' );
ok( File::Flat->fileSize( $f{append_2} ) == 0, '->truncate( file, 0 ) truncates to 0 bytes' );

$rv = File::Flat->truncate( $f{append_3}, 5 );
ok( $rv, '->truncate( file, 5 ) returns true for existing file' );
ok( -e $f{append_3}, '->truncate( file, 5 ): File still exists' );
ok( File::Flat->fileSize( $f{append_3} ) == 5, '->truncate( file, 5 ) truncates to 5 bytes' );





#####################################################################
# Test the prune method

# Create the test directories
foreach ( 1 .. 5 ) {
	my $directory = $f{"prune_$_"};
	ok( File::Flat->makeDirectory( $directory ), "Created test directory '$directory'" );
}

# Prune beneath the single dir
$rv = File::Flat->prune( catfile($f{prune_1}, 'file.txt') );
ok( $rv,              '->prune(single) returned true' );
ok( ! -e $f{prune_1}, '->prune(single) removed the single' );
ok(   -d $f{prune},   '->prune(single) didn\'t remove the master prunedir' );

# Prune beneath the multiple dir
$rv = File::Flat->prune( catfile($f{prune_2}, 'here') );
ok( $rv,               '->prune(multiple) returned true' );
ok( ! -e $f{prune_2},  '->prune(multiple) removed the top dir' );
ok( ! -e $f{prune_2a}, '->prune(multiple) removed all the dirs' );
ok(   -d $f{prune},    '->prune(multiple) didn\'t remove the master prunedir' );

# Prune stops correctly
$rv = File::Flat->prune( catfile($f{prune_3}, 'foo') );
ok( $rv,              '->prune(branched) returned true' );
ok( ! -e $f{prune_3}, '->prune(branched) removed the correct directory' );
ok(   -d $f{prune_4}, '->prune(branched) doesn\'t remove side directory' );
ok(   -d $f{prune},   '->prune(branched) didn\'t remove the master prunedir' );

# Don't prune anything
$rv = File::Flat->prune( catfile($f{prune_4a}, 'blah') );
ok( $rv,            '->prune(nothing) returned true' );
ok( -d $f{prune_4}, '->prune(nothing) doesn\'t remove side directory' );
ok( -d $f{prune},   '->prune(nothing) didn\'t remove the master prunedir' );

# Error when used as delete
$rv = File::Flat->prune( $f{prune_5} );
is( $rv, undef, '->prune(existing) returns an error' );
ok( File::Flat->errstr, '->prune(existing) sets ->errstr' );

# Test remove, with the prune option.

# Start by copying in some files to work with.
# We'll use the last of the untouched append files
foreach ( 1 .. 6 ) {
	ok( File::Flat->copy( $f{append_4}, catdir( $f{"remove_prune_$_"}, 'file' ) ), 'Copied in delete/prune test file' );
}

# By default, AUTOPRUNE is off and we don't tell ->remove to prune
ok( File::Flat->remove( catdir( $f{remove_prune_1}, 'file' ) ), '->remove(default) returns true' );
ok( -d $f{remove_prune_1}, '->remove(default) leaves dir intact' );

# Try with AUTOPRUNE on
AUTOPRUNE: {
	local $File::Flat::AUTO_PRUNE = 1;
	ok( File::Flat->remove( catdir( $f{remove_prune_2}, 'file' ) ), '->remove(AUTO_PRUNE) returns true' );
	ok( ! -e $f{remove_prune_2}, '->remove(AUTO_PRUNE) prunes directory' );
}

# By default, AUTOPRUNE is off
ok( File::Flat->remove( catdir( $f{remove_prune_3}, 'file' ) ), '->remove(default) returns true' );
ok( -d $f{remove_prune_3}, '->remove(default) leaves dir intact (AUTO_PRUNE used locally localises correctly)' );

# Tell ->remove to prune
ok( File::Flat->remove( catdir( $f{remove_prune_4}, 'file' ), 1 ), '->remove(prune) returns true' );
ok( ! -e $f{remove_prune_4}, '->remove(AUTO_PRUNE) prunes directory' );

# Tell ->remove explicitly not to prune
ok( File::Flat->remove( catdir( $f{remove_prune_5}, 'file' ), '' ), '->remove(noprune) returns true' );
ok( -d $f{remove_prune_5}, '->remove(noprune) leaves dir intact' );

# Make sure there's no warning with undef false value
ok( File::Flat->remove( catdir( $f{remove_prune_6}, 'file' ), undef ), '->remove(noprune) returns true' );
ok( -d $f{remove_prune_6}, '->remove(noprune) leaves dir intact' );

exit();





sub check_content_file {
	my $file = shift;
	return undef unless -e $file;
	return undef unless -r $file;

	open( FILE, $file ) or return undef;
	@content = <FILE>;
	chomp @content;
	close FILE;

	return undef unless scalar @content == 4;
	return undef unless $content[0] eq 'one';
	return undef unless $content[1] eq 'two';
	return undef unless $content[2] eq 'three';
	return undef unless $content[3] eq '';

	return 1;
}

END {
	# When we finish there are going to be some pretty fucked up files.
	# Make them less so.
	foreach my $clean1 ( qw{
		0000 0100 0200 0300 0400 0500 0600 0700
		ff_handle moved_1
		write_1 write_2 write_3 write_4 write_5 write_6
		over_1 over_2 over_3 over_4
		append_1 append_2 append_3 append_4
		size_1 size_2 size_3
		trunc_1
	} ) {
		if ( -e $clean1 ) {
			chmod 0600, $clean1;
			unlink $clean1;
			next;
		}
		my $clean2 = catfile( 't', $clean1 );
		if ( -e $clean2 ) {
			chmod 0600, $clean2;
			unlink $clean2;
			next;
		}
	}

	foreach my $dir ( qw{a b baddir gooddir} ) {
		next unless -e $f{$dir};
		chmod_R( 0700, $f{$dir} );
		remove \1, $f{$dir};
	}

	remove \1, $f{prune};
}