#!/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 = ; 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}; }