Commit 8e581653ede105782ee8fb8d9dd54665adbbdcd6 - libfile-flat-perl

Adding 01_compile.t. Making calls to CORE::open explicit Adam Kennedy 16 years ago

6 changed file(s) with 861 addition(s) and 848 deletion(s). Raw diff Collapse all Expand all

-2

lib/File/Flat.pm less more

186	186	my $file = shift;
187	187	local $/ = undef;
188	188	local *SLURP;
189		open( SLURP, "<$file" ) or return undef;
	189	CORE::open( SLURP, "<$file" ) or return undef;
190	190	my $source = <SLURP>;
191		close( SLURP ) or return undef;
	191	CORE::close( SLURP ) or return undef;
192	192	\$source;
193	193	}
194	194

-60

~~t/01_api.t~~ less more

0		#!/usr/bin/perl
1
2		# Basic first pass API testing for File::Flat
3
4		use strict;
5		BEGIN {
6		$\| = 1;
7		$^W = 1;
8		}
9
10		# Execute the tests
11		use Test::More 'tests' => 63;
12		use File::Flat;
13
14		# Execute the tests
15		use Test::ClassAPI;
16		Test::ClassAPI->execute('complete');
17		exit(0);
18
19		# Define the API
20		__DATA__
21		File::Flat=class
22		File::Flat::Object=class
23
24		[File::Flat]
25		exists=method
26		isaFile=method
27		isaDirectory=method
28		canRead=method
29		canWrite=method
30		canReadWrite=method
31		canExecute=method
32		canOpen=method
33		canRemove=method
34		isText=method
35		isBinary=method
36		fileSize=method
37
38		open=method
39		getReadHandle=method
40		getWriteHandle=method
41		getAppendHandle=method
42		getReadWriteHandle=method
43		slurp=method
44		read=method
45		write=method
46		overwrite=method
47		append=method
48		truncate=method
49
50		copy=method
51		move=method
52		remove=method
53		prune=method
54		makeDirectory=method
55		errstr=method
56
57		[File::Flat::Object]
58		File::Flat=implements
59		new=method

+13

-0

t/01_compile.t less more

	0	#!/usr/bin/perl
	1
	2	use strict;
	3	BEGIN {
	4	$\| = 1;
	5	$^W = 1;
	6	}
	7
	8	use Test::More tests => 2;
	9
	10	ok( $] >= 5.005, 'Perl version is new enough' );
	11
	12	use_ok( 'File::Flat' );

+60

-0

t/02_api.t less more

	0	#!/usr/bin/perl
	1
	2	# Basic first pass API testing for File::Flat
	3
	4	use strict;
	5	BEGIN {
	6	$\| = 1;
	7	$^W = 1;
	8	}
	9
	10	# Execute the tests
	11	use Test::More 'tests' => 63;
	12	use File::Flat;
	13
	14	# Execute the tests
	15	use Test::ClassAPI;
	16	Test::ClassAPI->execute('complete');
	17	exit(0);
	18
	19	# Define the API
	20	__DATA__
	21	File::Flat=class
	22	File::Flat::Object=class
	23
	24	[File::Flat]
	25	exists=method
	26	isaFile=method
	27	isaDirectory=method
	28	canRead=method
	29	canWrite=method
	30	canReadWrite=method
	31	canExecute=method
	32	canOpen=method
	33	canRemove=method
	34	isText=method
	35	isBinary=method
	36	fileSize=method
	37
	38	open=method
	39	getReadHandle=method
	40	getWriteHandle=method
	41	getAppendHandle=method
	42	getReadWriteHandle=method
	43	slurp=method
	44	read=method
	45	write=method
	46	overwrite=method
	47	append=method
	48	truncate=method
	49
	50	copy=method
	51	move=method
	52	remove=method
	53	prune=method
	54	makeDirectory=method
	55	errstr=method
	56
	57	[File::Flat::Object]
	58	File::Flat=implements
	59	new=method

-786

~~t/02_main.t~~ less more

0		#!/usr/bin/perl
1
2		# Formal testing for File::Flat
3
4		use strict;
5		use File::Spec::Functions ':ALL';
6		BEGIN {
7		$\| = 1;
8		$^W = 1;
9		}
10
11		use File::Copy 'copy';
12		use File::Remove 'remove';
13		use File::Find 'find';
14
15		# If we are root, some things we WANT to fail won't,
16		# and we'll have to skip some tests.
17		use vars qw{$root $win32};
18		BEGIN {
19		$root = ($> == 0) ? 1 : 0;
20		$win32 = ($^O eq 'MSWin32') ? 1 : 0;
21		}
22
23		# cygwin permissions are insane, so lets treat everyone like
24		# root and skip all the relevant tests.
25		# we ALSO want to skip all the tests (mostly related to canExecute)
26		# that fail on Win32.
27		BEGIN {
28		if ( $^O eq 'cygwin' ) {
29		$root = 1;
30		$win32 = 1;
31		}
32		}
33
34		use Test::More tests => 269;
35
36		# Set up any needed globals
37		use vars qw{$loaded $ci $bad};
38		use vars qw{$content_string @content_array $content_length};
39		use vars qw{$curdir %f};
40		BEGIN {
41		$loaded = 0;
42		$\| = 1;
43		$content_string = "one\ntwo\nthree\n\n";
44		@content_array = ( 'one', 'two', 'three', '' );
45		$content_length = length $content_string;
46
47		# Define all the paths we are going to need in advance
48		$curdir = curdir();
49		%f = (
50		null => catfile( $curdir, 'null' ),
51		something => catfile( $curdir, 'something' ),
52
53		rwx => catfile( $curdir, '0000' ),
54		Rwx => catfile( $curdir, '0400' ),
55		rWx => catfile( $curdir, '0200' ),
56		rwX => catfile( $curdir, '0100' ),
57		RWx => catfile( $curdir, '0600' ),
58		RwX => catfile( $curdir, '0500' ),
59		rWX => catfile( $curdir, '0300' ),
60		RWX => catfile( $curdir, '0700' ),
61		gooddir => catdir( $curdir, 'gooddir' ),
62		baddir => catdir( $curdir, 'baddir' ),
63
64		ff_handle => catfile( $curdir, 't', 'ff_handle' ),
65		ff_binary => catfile( $curdir, 't', 'ff_binary' ),
66		ff_text => catfile( $curdir, 't', 'ff_text' ),
67		ff_content => catfile( $curdir, 't', 'ff_content' ),
68
69		ff_content2 => catfile( $curdir, 'ff_content2' ),
70		a_ff_text3 => catfile( $curdir, 'a', 'ff_text3' ),
71		abcde_ff_text3 => catfile( $curdir, 'a', 'b', 'c', 'd', 'e', 'ff_text3' ),
72		abdde_ff_text3 => catfile( $curdir, 'a', 'b', 'd', 'd', 'e', 'ff_text3' ),
73		abc => catdir( $curdir, 'a', 'b', 'c' ),
74		abd => catdir( $curdir, 'a', 'b', 'd' ),
75		a => catdir( $curdir, 'a' ),
76		b => catdir( $curdir, 'b' ),
77
78		moved_1 => catfile( $curdir, 'moved_1' ),
79		moved_2 => catfile( $curdir, 'b', 'c', 'd', 'e', 'moved_2' ),
80
81		write_1 => catfile( $curdir, 'write_1' ),
82		write_2 => catfile( $curdir, 'write_2' ),
83		write_3 => catfile( $curdir, 'write_3' ),
84		write_4 => catfile( $curdir, 'write_4' ),
85		write_5 => catfile( $curdir, 'write_5' ),
86		write_6 => catfile( $curdir, 'write_6' ),
87
88		over_1 => catfile( $curdir, 'over_1' ),
89		over_2 => catfile( $curdir, 'over_2' ),
90		over_3 => catfile( $curdir, 'over_3' ),
91		over_4 => catfile( $curdir, 'over_4' ),
92
93		append_1 => catfile( $curdir, 'append_1' ),
94		append_2 => catfile( $curdir, 'append_2' ),
95		append_3 => catfile( $curdir, 'append_3' ),
96		append_4 => catfile( $curdir, 'append_4' ),
97
98		size_1 => catfile( $curdir, 'size_1' ),
99		size_2 => catfile( $curdir, 'size_2' ),
100		size_3 => catfile( $curdir, 'size_3' ),
101
102		trunc_1 => catfile( $curdir, 'trunc_1' ),
103
104		prune => catdir( $curdir, 'prunedir' ),
105		prune_1 => catdir( $curdir, 'prunedir', 'single' ),
106		prune_2 => catdir( $curdir, 'prunedir', 'multiple', 'lots', 'of', 'dirs' ),
107		prune_2a => catdir( $curdir, 'prunedir', 'multiple' ),
108		prune_3 => catdir( $curdir, 'prunedir', 'onlyone', 'thisone' ),
109		prune_4 => catdir( $curdir, 'prunedir', 'onlyone', 'notthis' ),
110		prune_4a => catdir( $curdir, 'prunedir', 'onlyone' ),
111		prune_5 => catdir( $curdir, 'prunedir', 'onlyone', 'notthis', 'orthis' ),
112
113		remove_prune_1 => catfile( $curdir, 'prunedir', 'remove', 'prune_1' ),
114		remove_prune_2 => catfile( $curdir, 'prunedir', 'remove', 'prune_2' ),
115		remove_prune_3 => catfile( $curdir, 'prunedir', 'remove', 'prune_3' ),
116		remove_prune_4 => catfile( $curdir, 'prunedir', 'remove', 'prune_4' ),
117		remove_prune_5 => catfile( $curdir, 'prunedir', 'remove', 'prune_5' ),
118		remove_prune_6 => catfile( $curdir, 'prunedir', 'remove', 'prune_6' ),
119		);
120
121		# Avoid some 'only used once' warnings
122		$File::Flat::errstr = $File::Flat::errstr;
123		$File::Flat::AUTO_PRUNE = $File::Flat::AUTO_PRUNE;
124		}
125
126		# Convenience functions to avoid system calls
127		sub touch_test_file($) {
128		# Do the 'touch' part
129		my $file = catfile( $curdir, $_[0] );
130		open FILE, ">>$file" or return undef;
131		close FILE;
132
133		# And now the chmod part
134		my $mask = oct($_[0]);
135		chmod $mask, $file or return undef;
136
137		1;
138		}
139
140		sub chmod_R($$) {
141		my($mask, $dir) = @_;
142		chmod $mask, $dir;
143		find( sub { chmod $mask, $File::Find::name }, $dir );
144		}
145
146		# Check their perl version, and that modules are installed
147		ok( $] >= 5.005, "Your perl is new enough" );
148		use_ok( 'File::Flat' );
149
150
151
152
153		# Check for the three files that should already exist
154		ok( -f $f{ff_text}, 'ff_text exists' );
155		ok( -f $f{ff_binary}, 'ff_binary exists' );
156		ok( -f $f{ff_content}, 'ff_content exists' );
157
158		# Create the files for the file test section
159		touch_test_file('0000') or die "Failed to create file we can do anything to";
160		touch_test_file('0400') or die "Failed to create file we can only read";
161		touch_test_file('0200') or die "Failed to create file we can only write";
162		touch_test_file('0100') or die "Failed to create file we can only execute";
163		touch_test_file('0600') or die "Failed to create file we can read and write";
164		touch_test_file('0500') or die "Failed to create file we can read and execute";
165		touch_test_file('0300') or die "Failed to create file we can write and execute";
166		touch_test_file('0700') or die "Failed to create file we can read, write and execute";
167
168		unless ( chmod 0777, $curdir ) {
169		die "Failed to set current directory to mode 777";
170		}
171		unless ( -e $f{gooddir} ) {
172		unless ( mkdir $f{gooddir}, 0755 ) {
173		die "Failed to create mode 0755 directory";
174		}
175		}
176		unless ( -e $f{baddir} ) {
177		unless ( mkdir $f{baddir}, 0000 ) {
178		die "Failed to create mode 0000 directory";
179		}
180		}
181
182		# We are also going to use a file called "./null" to represent
183		# a file that doesn't exist.
184
185
186
187		### Test Section 1
188		# Here we will test all the static methods that are handled directly, and
189		# not passed on to the object form of the methods.
190
191		# Test the error message handling
192		my $error_message = 'foo';
193		my $rv = File::Flat->_error( $error_message );
194		ok( ! defined $rv, "->_error returns undef" );
195		ok( $File::Flat::errstr eq $error_message, "->_error sets error message" );
196		ok( File::Flat->errstr eq $error_message, "->errstr retrieves error message" );
197
198		# Test the static ->exists method
199		ok( ! File::Flat->exists( $f{null} ), "Static ->exists doesn't see missing file" );
200		ok( File::Flat->exists( $f{rwx} ), "Static ->exists sees mode 000 file" );
201		ok( File::Flat->exists( $f{Rwx} ), "Static ->exists sees mode 400 file" );
202		ok( File::Flat->exists( $f{RWX} ), "Static ->exists sees mode 700 file" );
203		ok( File::Flat->exists( $curdir ), "Static ->exists sees . directory" );
204		ok( File::Flat->exists( $f{baddir} ), "Static ->exists sees mode 000 directory" );
205
206		# Test the static ->isaFile method
207		ok( ! File::Flat->isaFile( $f{null} ), "Static ->isaFile returns false for missing file" );
208		ok( File::Flat->isaFile( $f{rwx} ), "Static ->isaFile returns true for mode 000 file" );
209		ok( File::Flat->isaFile( $f{RWX} ), "Static ->isaFile returns true for mode 700 file" );
210		ok( ! File::Flat->isaFile( $curdir ), "Static ->isaFile returns false for current directory" );
211		ok( ! File::Flat->isaFile( $f{gooddir} ), "Static ->isaFile returns false for subdirectory" );
212
213		# Test the static ->isaDirectory method
214		ok( ! File::Flat->isaDirectory( $f{null} ), "Static ->isaDirectory returns false for missing directory" );
215		ok( ! File::Flat->isaDirectory( $f{rwx} ), "Static ->isaDirectory returns false for mode 000 file" );
216		ok( ! File::Flat->isaDirectory( $f{RWX} ), "Static ->isaDirectory returns false for mode 700 file" );
217		ok( File::Flat->isaDirectory( $curdir ), "Static ->isaDirectory returns true for current directory" );
218		ok( File::Flat->isaDirectory( $f{gooddir} ), "Static ->isaDirectory returns true for readable subdirectory" );
219		ok( File::Flat->isaDirectory( $f{baddir} ), "Static ->isaDirectory return true for unreadable subdirectory" );
220
221		# Test the static ->canRead method
222		ok( ! File::Flat->canRead( $f{null} ), "Static ->canRead returns false for missing file" );
223		SKIP: {
224		skip "Skipping tests known to fail for root", 1 if $root;
225		ok( ! File::Flat->canRead( $f{rwx} ), "Static ->canRead returns false for mode 000 file" );
226		}
227		ok( File::Flat->canRead( $f{Rwx} ), "Static ->canRead returns true for mode 400 file" );
228		SKIP: {
229		skip "Skipping tests known to fail for root", 2 if $root;
230		ok( ! File::Flat->canRead( $f{rWx} ), "Static ->canRead returns false for mode 200 file" );
231		ok( ! File::Flat->canRead( $f{rwX} ), "Static ->canRead returns false for mode 100 file" );
232		}
233		ok( File::Flat->canRead( $f{RWx} ), "Static ->canRead returns true for mode 500 file" );
234		ok( File::Flat->canRead( $f{RwX} ), "Static ->canRead returns true for mode 300 file" );
235		ok( File::Flat->canRead( $f{RWX} ), "Static ->canRead returns true for mode 700 file" );
236		ok( File::Flat->canRead( $curdir ), "Static ->canRead returns true for current directory" );
237		ok( File::Flat->canRead( $f{gooddir} ), "Static ->canRead returns true for readable subdirectory" );
238		SKIP: {
239		skip "Skipping tests known to fail for root", 1 if $root;
240		ok( ! File::Flat->canRead( $f{baddir} ), "Static ->canRead returns false for unreadable subdirectory" );
241		}
242
243
244		# Test the static ->canWrite method
245		ok( File::Flat->canWrite( $f{null} ), "Static ->canWrite returns true for missing, creatable, file" );
246		SKIP: {
247		skip "Skipping tests known to fail for root", 2 if $root;
248		ok( ! File::Flat->canWrite( $f{rwx} ), "Static ->canWrite returns false for mode 000 file" );
249		ok( ! File::Flat->canWrite( $f{Rwx} ), "Static ->canWrite returns false for mode 400 file" );
250		}
251		ok( File::Flat->canWrite( $f{rWx} ), "Static ->canWrite returns true for mode 200 file" );
252		SKIP: {
253		skip "Skipping tests known to fail for root", 1 if $root;
254		ok( ! File::Flat->canWrite( $f{rwX} ), "Static ->canWrite returns false for mode 100 file" );
255		}
256		ok( File::Flat->canWrite( $f{RWx} ), "Static ->canWrite returns true for mode 500 file" );
257		SKIP: {
258		skip "Skipping tests known to fail for root", 1 if $root;
259		ok( ! File::Flat->canWrite( $f{RwX} ), "Static ->canWrite returns false for mode 300 file" );
260		}
261		ok( File::Flat->canWrite( $f{RWX} ), "Static ->canWrite returns true for mode 700 file" );
262		ok( File::Flat->canWrite( $curdir ), "Static ->canWrite returns true for current directory" );
263		ok( File::Flat->canWrite( $f{gooddir} ), "Static ->canWrite returns true for writable subdirectory" );
264		SKIP: {
265		skip "Skipping tests known to fail for root", 2 if $root;
266		ok( ! File::Flat->canWrite( $f{baddir} ), "Static ->canWrite returns false for unwritable subdirectory" );
267		ok( ! File::Flat->canWrite( catfile($f{baddir}, 'file') ), "Static ->canWrite returns false for missing, non-creatable file" );
268		}
269
270		# Test the static ->canReadWrite method
271		ok( ! File::Flat->canReadWrite( $f{null} ), "Static ->canReadWrite returns false for missing file" );
272		SKIP: {
273		skip "Skipping tests known to fail for root", 4 if $root;
274		ok( ! File::Flat->canReadWrite( $f{rwx} ), "Static ->canReadWrite returns false for mode 000 file" );
275		ok( ! File::Flat->canReadWrite( $f{Rwx} ), "Static ->canReadWrite returns false for mode 400 file" );
276		ok( ! File::Flat->canReadWrite( $f{rWx} ), "Static ->canReadWrite returns false for mode 200 file" );
277		ok( ! File::Flat->canReadWrite( $f{rwX} ), "Static ->canReadWrite returns false for mode 100 file" );
278		}
279		ok( File::Flat->canReadWrite( $f{RWx} ), "Static ->canReadWrite returns true for mode 500 file" );
280		SKIP: {
281		skip "Skipping tests known to fail for root", 1 if $root;
282		ok( ! File::Flat->canReadWrite( $f{RwX} ), "Static ->canReadWrite returns false for mode 300 file" );
283		}
284		ok( File::Flat->canReadWrite( $f{RWX} ), "Static ->canReadWrite returns true for mode 700 file" );
285		ok( File::Flat->canReadWrite( $curdir ), "Static ->canReadWrite returns true for current directory" );
286		ok( File::Flat->canReadWrite( $f{gooddir} ), "Static ->canReadWrite returns true for readwritable subdirectory" );
287		SKIP: {
288		skip "Skipping tests known to fail for root", 1 if $root;
289		ok( ! File::Flat->canReadWrite( $f{baddir} ), "Static ->canReadWrite returns false for unreadwritable subdirectory" );
290		}
291
292		# Test the static ->canExecute method
293		SKIP: {
294		skip( "Skipping tests known to falsely fail on Win32", 11 ) if $win32;
295
296		ok( ! File::Flat->canExecute( $f{null} ), "Static ->canExecute returns false for missing file" );
297		ok( ! File::Flat->canExecute( $f{rwx} ), "Static ->canExecute returns false for mode 000 file" );
298		ok( ! File::Flat->canExecute( $f{Rwx} ), "Static ->canExecute returns false for mode 400 file" );
299		ok( ! File::Flat->canExecute( $f{rWx} ), "Static ->canExecute returns false for mode 200 file" );
300		ok( File::Flat->canExecute( $f{rwX} ), "Static ->canExecute returns true for mode 100 file" );
301		ok( ! File::Flat->canExecute( $f{RWx} ), "Static ->canExecute returns false for mode 500 file" );
302		ok( File::Flat->canExecute( $f{RwX} ), "Static ->canExecute returns true for mode 300 file" );
303		ok( File::Flat->canExecute( $f{RWX} ), "Static ->canExecute returns true for mode 700 file" );
304		ok( File::Flat->canExecute( $curdir ), "Static ->canExecute returns true for current directory" );
305		ok( File::Flat->canExecute( $f{gooddir} ), "Static ->canExecute returns true for executable subdirectory" );
306
307		skip( "Skipping tests known to falsely fail for root", 1 ) if $root;
308		ok( ! File::Flat->canExecute( $f{baddir} ), "Static ->canExecute returns false for unexecutable subdirectory" );
309		}
310
311		# Test the static ->canOpen method
312		ok( ! File::Flat->canOpen( $f{null} ), "Static ->canOpen returns false for missing file" );
313		SKIP: {
314		skip "Skipping tests known to fail for root", 1 if $root;
315		ok( ! File::Flat->canOpen( $f{rwx} ), "Static ->canOpen returns false for mode 000 file" );
316		}
317		ok( File::Flat->canOpen( $f{Rwx} ), "Static ->canOpen returns true for mode 400 file" );
318		SKIP: {
319		skip "Skipping tests known to fail for root", 2 if $root;
320		ok( ! File::Flat->canOpen( $f{rWx} ), "Static ->canOpen returns false for mode 200 file" );
321		ok( ! File::Flat->canOpen( $f{rwX} ), "Static ->canOpen returns false for mode 100 file" );
322		}
323		ok( File::Flat->canOpen( $f{RWx} ), "Static ->canOpen returns true for mode 500 file" );
324		ok( File::Flat->canOpen( $f{RwX} ), "Static ->canOpen returns true for mode 300 file" );
325		ok( File::Flat->canOpen( $f{RWX} ), "Static ->canOpen returns true for mode 700 file" );
326		ok( ! File::Flat->canOpen( $curdir ), "Static ->canOpen returns false for current directory" );
327		ok( ! File::Flat->canOpen( $f{gooddir} ), "Static ->canOpen returns false for readable subdirectory" );
328		ok( ! File::Flat->canOpen( $f{baddir} ), "Static ->canOpen returns false for unreadable subdirectory" );
329
330		# Test the existance of normal and/or binary files
331		ok( ! File::Flat->isText( $f{null} ), "Static ->isText returns false for missing file" );
332		ok( ! File::Flat->isText( $f{ff_binary} ), "Static ->isText returns false for binary file" );
333		ok( File::Flat->isText( $f{ff_text} ), "Static ->isText returns true for text file" );
334		ok( ! File::Flat->isText( $f{gooddir} ), "Static ->isText returns false for good subdirectory" );
335		ok( ! File::Flat->isText( $f{baddir} ), "Static ->isText returns false for bad subdirectory" );
336		ok( ! File::Flat->isBinary( $f{null} ), "Static ->isBinary returns false for missing file" );
337		ok( File::Flat->isBinary( $f{ff_binary} ), "Static ->isBinary returns true for binary file" );
338		ok( ! File::Flat->isBinary( $f{ff_text} ), "Static ->isBinary returns false for text file" );
339		ok( ! File::Flat->isBinary( $f{gooddir} ), "Static ->isBinary return false for good subdirectory" );
340		ok( ! File::Flat->isBinary( $f{baddir} ), "Static ->isBinary returns false for bad subdirectory" );
341
342		my %handle = ();
343
344		# Do open handle methods return false for bad values
345		$handle{generic} = File::Flat->open( $f{null} );
346		$handle{readhandle} = File::Flat->open( $f{null} );
347		$handle{writehandle} = File::Flat->open( $f{null} );
348		$handle{appendhandle} = File::Flat->open( $f{null} );
349		$handle{readwritehandle} = File::Flat->open( $f{null} );
350		ok( ! defined $handle{generic}, "Static ->open call returns undef on bad file name" );
351		ok( ! defined $handle{readhandle}, "Static ->getReadHandle returns undef on bad file name" );
352		ok( ! defined $handle{writehandle}, "Static ->getWriteHandle returns undef on bad file name" );
353		ok( ! defined $handle{appendhandle}, "Static ->getAppendHandle returns undef on bad file name" );
354		ok( ! defined $handle{readwritehandle}, "Static ->getReadWriteHandle returns undef on bad file name" );
355
356		# Do the open methods at least return a file handle
357		copy( $f{ff_text}, $f{ff_handle} ) or die "Failed to copy file in preperation for test";
358		$handle{generic} = File::Flat->open( $f{ff_handle} );
359		$handle{readhandle} = File::Flat->getReadHandle( $f{ff_handle} );
360		$handle{writehandle} = File::Flat->getWriteHandle( $f{ff_handle} );
361		$handle{appendhandle} = File::Flat->getAppendHandle( $f{ff_handle} );
362		$handle{readwritehandle} = File::Flat->getReadWriteHandle( $f{ff_handle} );
363		isa_ok( $handle{generic}, 'IO::File' ); # Static ->open call returns IO::File object
364		isa_ok( $handle{readhandle}, 'IO::File' ); # Static ->getReadHandle returns IO::File object
365		isa_ok( $handle{writehandle}, 'IO::File' ); # Static ->getWriteHandle returns IO::File object
366		isa_ok( $handle{appendhandle}, 'IO::File' ); # Static ->getAppendHandle returns IO::File object
367		isa_ok( $handle{readwritehandle}, 'IO::File' ); # Static ->getReadWriteHandle returns IO::File object
368
369
370
371
372
373
374		# Test the static ->copy method
375		ok( ! defined File::Flat->copy(), '->copy() returns error' );
376		ok( ! defined File::Flat->copy( $f{ff_content} ), '->copy( file ) returns error' );
377
378		$rv = File::Flat->copy( $f{ff_content}, $f{ff_content2} );
379		ok( $rv, "Static ->copy returns true correctly for same directory copy" );
380		ok( -e $f{ff_content2}, "Static ->copy actually created the file for same directory copy" );
381		ok( check_content_file( $f{ff_content2} ), "Static ->copy copies the file without breaking it" );
382
383		$rv = File::Flat->copy( $f{ff_text}, $f{a_ff_text3} );
384		ok( $rv, "Static ->copy returns true correctly for single sub-directory copy" );
385		ok( -e $f{a_ff_text3}, "Static ->copy actually created the file for single sub-directory copy" );
386
387		$rv = File::Flat->copy( $f{ff_text}, $f{abcde_ff_text3} );
388		ok( $rv, "Static ->copy returns true correctly for multiple sub-directory copy" );
389		ok( -e $f{abcde_ff_text3}, "Static ->copy actually created the file for multiple sub-directory copy" );
390
391		$rv = File::Flat->copy( $f{null}, $f{something} );
392		ok( ! $rv, "Static ->copy return undef when file does not exist" );
393
394		# Directory copying
395		$rv = File::Flat->copy( $f{abc}, $f{abd} );
396		SKIP: {
397		skip "Skipping tests known to fail for root", 1 if $root;
398		ok( $rv, '->copy( dir, dir ) returns true' );
399		}
400		ok( -d $f{abd}, '->copy( dir, dir ): New dir exists' );
401		ok( -f $f{abdde_ff_text3}, '->copy( dir, dir ): Files within directory were copied' );
402
403		# Test the static ->move method
404		$rv = File::Flat->move( $f{abcde_ff_text3}, $f{moved_1} );
405		ok( $rv, "Static ->move for move to existing directory returns true " );
406		ok( ! -e $f{abcde_ff_text3}, "Static ->move for move to existing directory actually removes the old file" );
407		ok( -e $f{moved_1}, "Static ->move for move to existing directory actually creates the new file" );
408
409		$rv = File::Flat->move( $f{ff_content2}, $f{moved_2} );
410		ok( $rv, "Static ->move for move to new directory returns true " );
411		ok( ! -e $f{ff_content2}, "Static ->move for move to new directory actually removes the old file" );
412		ok( -e $f{moved_2}, "Static ->move for move to new directory actually creates the new file" );
413		ok( check_content_file( $f{moved_2} ), "Static ->move moved the file without breaking it" );
414
415
416
417
418
419
420		# Test the static ->slurp method
421		ok( check_content_file( $f{ff_content} ), "Content tester works" );
422		my $content = File::Flat->slurp();
423		ok( ! defined $content, "Static ->slurp returns error on no arguments" );
424		$content = File::Flat->slurp( $f{null} );
425		ok( ! defined $content, "Static ->slurp returns error on bad file" );
426		$content = File::Flat->slurp( $f{ff_content} );
427		ok( defined $content, "Static ->slurp returns defined" );
428		ok( defined $content, "Static ->slurp returns something" );
429		ok( UNIVERSAL::isa( $content, 'SCALAR' ), "Static ->slurp returns a scalar reference" );
430		ok( length $$content, "Static ->slurp returns content" );
431		ok( $$content eq $content_string, "Static ->slurp returns the correct file contents" );
432
433		# Test the static ->read
434		$content = File::Flat->read();
435		ok( ! defined $content, "Static ->read returns error on no arguments" );
436		$content = File::Flat->read( $f{null} );
437		ok( ! defined $content, "Static ->read returns error on bad file" );
438		$content = File::Flat->read( $f{ff_content} );
439		ok( defined $content, "Static ->read doesn't error on good file" );
440		ok( $content, "Static ->read returns true on good file" );
441		ok( ref $content, "Static ->read returns a reference on good file" );
442		ok( UNIVERSAL::isa( $content, 'ARRAY' ), "Static ->read returns an array ref on good file" );
443		ok( scalar @$content == 4, "Static ->read returns the correct length of data" );
444		my $matches = (
445		$content->[0] eq 'one'
446		and $content->[1] eq 'two'
447		and $content->[2] eq 'three'
448		and $content->[3] eq ''
449		) ? 1 : 0;
450		ok( $matches, "Static ->read returns the expected content" );
451
452		# And again in an array context
453		my @content = File::Flat->read();
454		ok( ! scalar @content, "Static ->read (array context) returns error on no arguments" );
455		@content = File::Flat->read( $f{null} );
456		ok( ! scalar @content, "Static ->read (array context) returns error on bad file" );
457		@content = File::Flat->read( $f{ff_content} );
458		ok( scalar @content, "Static ->read (array context) doesn't error on good file" );
459		ok( scalar @content == 4, "Static ->read (array context) returns the correct length of data" );
460		$matches = (
461		$content[0] eq 'one'
462		and $content[1] eq 'two'
463		and $content[2] eq 'three'
464		and $content[3] eq ''
465		) ? 1 : 0;
466		ok( $matches, "Static ->read (array context) returns the expected content" );
467
468
469
470
471
472		# Test the many and varies write() options.
473		ok( ! File::Flat->write(), "->write() fails correctly" );
474		ok( ! File::Flat->write( $f{write_1} ), "->write( file ) fails correctly" );
475		ok( ! -e $f{write_1}, "->write( file ) doesn't actually create a file" );
476
477		$rv = File::Flat->write( $f{write_1}, $content_string );
478		ok( $rv, "->File::Flat->write( file, string ) returns true" );
479		ok( -e $f{write_1}, "->write( file, string ) actually creates a file" );
480		ok( check_content_file( $f{write_1} ), "->write( file, string ) writes the correct content" );
481
482		$rv = File::Flat->write( $f{write_2}, $content_string );
483		ok( $rv, "->File::Flat->write( file, string_ref ) returns true" );
484		ok( -e $f{write_2}, "->write( file, string_ref ) actually creates a file" );
485		ok( check_content_file( $f{write_2} ), "->write( file, string_ref ) writes the correct content" );
486
487		$rv = File::Flat->write( $f{write_3}, \@content_array );
488		ok( $rv, "->write( file, array_ref ) returns true" );
489		ok( -e $f{write_3}, "->write( file, array_ref ) actually creates a file" );
490		ok( check_content_file( $f{write_3} ), "->write( file, array_ref ) writes the correct content" );
491
492		# Repeat with a handle first argument
493		my $handle = File::Flat->getWriteHandle( $f{write_4} );
494		ok( ! File::Flat->write( $handle ), "->write( handle ) fails correctly" );
495		ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
496		$rv = File::Flat->write( $handle, $content_string );
497		$handle->close();
498		ok( $rv, "->write( handle, string ) returns true" );
499		ok( -e $f{write_4}, "->write( handle, string ) actually creates a file" );
500		ok( check_content_file( $f{write_1} ), "->write( handle, string ) writes the correct content" );
501
502		$handle = File::Flat->getWriteHandle( $f{write_5} );
503		ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
504		$rv = File::Flat->write( $handle, $content_string );
505		$handle->close();
506		ok( $rv, "->File::Flat->write( handle, string_ref ) returns true" );
507		ok( -e $f{write_5}, "->write( handle, string_ref ) actually creates a file" );
508		ok( check_content_file( $f{write_5} ), "->write( handle, string_ref ) writes the correct content" );
509
510		$handle = File::Flat->getWriteHandle( $f{write_6} );
511		ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
512		$rv = File::Flat->write( $handle, \@content_array );
513		$handle->close();
514		ok( $rv, "->File::Flat->write( handle, array_ref ) returns true" );
515		ok( -e $f{write_6}, "->write( handle, array_ref ) actually creates a file" );
516		ok( check_content_file( $f{write_6} ), "->write( handle, array_ref ) writes the correct content" );
517
518
519
520
521
522
523		# Check the ->overwrite method
524		ok( ! File::Flat->overwrite(), "->overwrite() fails correctly" );
525		ok( ! File::Flat->overwrite( $f{over_1} ), "->overwrite( file ) fails correctly" );
526		ok( ! -e $f{over_1}, "->overwrite( file ) doesn't actually create a file" );
527
528		$rv = File::Flat->overwrite( $f{over_1}, $content_string );
529		ok( $rv, "->File::Flat->overwrite( file, string ) returns true" );
530		ok( -e $f{over_1}, "->overwrite( file, string ) actually creates a file" );
531		ok( check_content_file( $f{over_1} ), "->overwrite( file, string ) writes the correct content" );
532
533		$rv = File::Flat->overwrite( $f{over_2}, $content_string );
534		ok( $rv, "->File::Flat->overwrite( file, string_ref ) returns true" );
535		ok( -e $f{over_2}, "->overwrite( file, string_ref ) actually creates a file" );
536		ok( check_content_file( $f{over_2} ), "->overwrite( file, string_ref ) writes the correct content" );
537
538		$rv = File::Flat->overwrite( $f{over_3}, \@content_array );
539		ok( $rv, "->overwrite( file, array_ref ) returns true" );
540		ok( -e $f{over_3}, "->overwrite( file, array_ref ) actually creates a file" );
541		ok( check_content_file( $f{over_3} ), "->overwrite( file, array_ref ) writes the correct content" );
542
543		# Check actually overwriting a file
544		ok ( File::Flat->copy( $f{ff_text}, $f{over_4} ), "Preparing for overwrite test" );
545		$rv = File::Flat->overwrite( $f{over_4}, \$content_string );
546		ok( $rv, "->overwrite( file, array_ref ) returns true" );
547		ok( -e $f{over_4}, "->overwrite( file, array_ref ) actually creates a file" );
548		ok( check_content_file( $f{over_4} ), "->overwrite( file, array_ref ) writes the correct content" );
549
550
551
552
553
554		# Check the basics of the ->remove method
555		ok( ! File::Flat->remove(), "->remove() correctly return an error" );
556		ok( ! File::Flat->remove( $f{null} ), "->remove( file ) returns an error for a nonexistant file" );
557		ok( File::Flat->remove( $f{over_4} ), "->remove( file ) returns true for existing file" );
558		ok( ! -e $f{over_4}, "->remove( file ) actually removes the file" );
559		ok( File::Flat->remove( $f{a} ), "->remove( directory ) returns true for existing directory" );
560		ok( ! -e $f{a}, "->remove( directory ) actually removes the directory" );
561
562
563
564
565
566		# Check the append method
567		ok( ! File::Flat->append(), "->append() correctly returns an error" );
568		ok( ! File::Flat->append( $f{append_1} ), "->append( file ) correctly returns an error" );
569		ok( ! -e $f{append_1}, "->append( file ) doesn't actually create a file" );
570
571		$rv = File::Flat->append( $f{append_1}, $content_string );
572		ok( $rv, "->File::Flat->append( file, string ) returns true" );
573		ok( -e $f{append_1}, "->append( file, string ) actually creates a file" );
574		ok( check_content_file( $f{append_1} ), "->append( file, string ) writes the correct content" );
575
576		$rv = File::Flat->append( $f{append_2}, $content_string );
577		ok( $rv, "->File::Flat->append( file, string_ref ) returns true" );
578		ok( -e $f{append_2}, "->append( file, string_ref ) actually creates a file" );
579		ok( check_content_file( $f{append_2} ), "->append( file, string_ref ) writes the correct content" );
580
581		$rv = File::Flat->append( $f{append_3}, \@content_array );
582		ok( $rv, "->append( file, array_ref ) returns true" );
583		ok( -e $f{append_3}, "->append( file, array_ref ) actually creates a file" );
584		ok( check_content_file( $f{append_3} ), "->append( file, array_ref ) writes the correct content" );
585
586		# Now let's try an actual append
587		ok( File::Flat->append( $f{append_4}, "one\ntwo\n" ), "Preparing for real append" );
588		$rv = File::Flat->append( $f{append_4}, "three\n\n" );
589		ok( $rv, "->append( file, array_ref ) for an actual append returns true" );
590		ok( -e $f{append_4}, "->append( file, array_ref ): File still exists" );
591		ok( check_content_file( $f{append_4} ), "->append( file, array_ref ) results in the correct file contents" );
592
593
594
595
596
597		# Test the ->fileSize method
598		ok( File::Flat->write( $f{size_1}, 'abcdefg' )
599		&& File::Flat->write( $f{size_2}, join '', ( 'd' x 100000 ) )
600		&& File::Flat->write( $f{size_3}, '' ),
601		"Preparing for file size tests"
602		);
603		ok( ! defined File::Flat->fileSize(), "->fileSize() correctly returns error" );
604		ok( ! defined File::Flat->fileSize( $f{null} ), '->fileSize( file ) returns error for nonexistant file' );
605		ok( ! defined File::Flat->fileSize( $f{a} ), '->fileSize( directory ) returns error' );
606		$rv = File::Flat->fileSize( $f{size_1} );
607		ok( defined $rv, "->fileSize( file ) returns true for small file" );
608		ok( $rv == 7, "->fileSize( file ) returns the correct size for small file" );
609		$rv = File::Flat->fileSize( $f{size_2} );
610		ok( defined $rv, "->fileSize( file ) returns true for big file" );
611		ok( $rv == 100000, "->fileSize( file ) returns the correct size for big file" );
612		$rv = File::Flat->fileSize( $f{size_3} );
613		ok( defined $rv, "->fileSize( file ) returns true for empty file" );
614		ok( $rv == 0, "->fileSize( file ) returns the correct size for empty file" );
615
616
617
618
619
620
621
622		# Test the ->truncate method. Use the append files
623		ok( ! defined File::Flat->truncate(), '->truncate() correctly returns error' );
624		SKIP: {
625		skip "Skipping tests known to fail for root", 1 if $root;
626		ok( ! defined File::Flat->truncate( $f{rwx} ), '->truncate( file ) returns error when no permissions' );
627		}
628		ok( ! defined File::Flat->truncate( './b' ), '->truncate( directory ) returns error' );
629		$rv = File::Flat->truncate( $f{trunc_1} );
630		ok( $rv, '->truncate( file ) returns true for non-existant file' );
631		ok( -e $f{trunc_1}, '->truncate( file ) creates new file' );
632		ok( File::Flat->fileSize( $f{trunc_1} ) == 0, '->truncate( file ) creates file of 0 bytes' );
633
634		$rv = File::Flat->truncate( $f{append_1} );
635		ok( $rv, '->truncate( file ) returns true for existing file' );
636		ok( -e $f{append_1}, '->truncate( file ): File still exists' );
637		ok( File::Flat->fileSize( $f{append_1} ) == 0, '->truncate( file ) truncates to 0 bytes' );
638
639		$rv = File::Flat->truncate( $f{append_2}, 0 );
640		ok( $rv, '->truncate( file, 0 ) returns true for existing file' );
641		ok( -e $f{append_2}, '->truncate( file, 0 ): File still exists' );
642		ok( File::Flat->fileSize( $f{append_2} ) == 0, '->truncate( file, 0 ) truncates to 0 bytes' );
643
644		$rv = File::Flat->truncate( $f{append_3}, 5 );
645		ok( $rv, '->truncate( file, 5 ) returns true for existing file' );
646		ok( -e $f{append_3}, '->truncate( file, 5 ): File still exists' );
647		ok( File::Flat->fileSize( $f{append_3} ) == 5, '->truncate( file, 5 ) truncates to 5 bytes' );
648
649
650
651
652
653		#####################################################################
654		# Test the prune method
655
656		# Create the test directories
657		foreach ( 1 .. 5 ) {
658		my $directory = $f{"prune_$_"};
659		ok( File::Flat->makeDirectory( $directory ), "Created test directory '$directory'" );
660		}
661
662		# Prune beneath the single dir
663		$rv = File::Flat->prune( catfile($f{prune_1}, 'file.txt') );
664		ok( $rv, '->prune(single) returned true' );
665		ok( ! -e $f{prune_1}, '->prune(single) removed the single' );
666		ok( -d $f{prune}, '->prune(single) didn\'t remove the master prunedir' );
667
668		# Prune beneath the multiple dir
669		$rv = File::Flat->prune( catfile($f{prune_2}, 'here') );
670		ok( $rv, '->prune(multiple) returned true' );
671		ok( ! -e $f{prune_2}, '->prune(multiple) removed the top dir' );
672		ok( ! -e $f{prune_2a}, '->prune(multiple) removed all the dirs' );
673		ok( -d $f{prune}, '->prune(multiple) didn\'t remove the master prunedir' );
674
675		# Prune stops correctly
676		$rv = File::Flat->prune( catfile($f{prune_3}, 'foo') );
677		ok( $rv, '->prune(branched) returned true' );
678		ok( ! -e $f{prune_3}, '->prune(branched) removed the correct directory' );
679		ok( -d $f{prune_4}, '->prune(branched) doesn\'t remove side directory' );
680		ok( -d $f{prune}, '->prune(branched) didn\'t remove the master prunedir' );
681
682		# Don't prune anything
683		$rv = File::Flat->prune( catfile($f{prune_4a}, 'blah') );
684		ok( $rv, '->prune(nothing) returned true' );
685		ok( -d $f{prune_4}, '->prune(nothing) doesn\'t remove side directory' );
686		ok( -d $f{prune}, '->prune(nothing) didn\'t remove the master prunedir' );
687
688		# Error when used as delete
689		$rv = File::Flat->prune( $f{prune_5} );
690		is( $rv, undef, '->prune(existing) returns an error' );
691		ok( File::Flat->errstr, '->prune(existing) sets ->errstr' );
692
693		# Test remove, with the prune option.
694
695		# Start by copying in some files to work with.
696		# We'll use the last of the untouched append files
697		foreach ( 1 .. 6 ) {
698		ok( File::Flat->copy( $f{append_4}, catdir( $f{"remove_prune_$_"}, 'file' ) ), 'Copied in delete/prune test file' );
699		}
700
701		# By default, AUTOPRUNE is off and we don't tell ->remove to prune
702		ok( File::Flat->remove( catdir( $f{remove_prune_1}, 'file' ) ), '->remove(default) returns true' );
703		ok( -d $f{remove_prune_1}, '->remove(default) leaves dir intact' );
704
705		# Try with AUTOPRUNE on
706		AUTOPRUNE: {
707		local $File::Flat::AUTO_PRUNE = 1;
708		ok( File::Flat->remove( catdir( $f{remove_prune_2}, 'file' ) ), '->remove(AUTO_PRUNE) returns true' );
709		ok( ! -e $f{remove_prune_2}, '->remove(AUTO_PRUNE) prunes directory' );
710		}
711
712		# By default, AUTOPRUNE is off
713		ok( File::Flat->remove( catdir( $f{remove_prune_3}, 'file' ) ), '->remove(default) returns true' );
714		ok( -d $f{remove_prune_3}, '->remove(default) leaves dir intact (AUTO_PRUNE used locally localises correctly)' );
715
716		# Tell ->remove to prune
717		ok( File::Flat->remove( catdir( $f{remove_prune_4}, 'file' ), 1 ), '->remove(prune) returns true' );
718		ok( ! -e $f{remove_prune_4}, '->remove(AUTO_PRUNE) prunes directory' );
719
720		# Tell ->remove explicitly not to prune
721		ok( File::Flat->remove( catdir( $f{remove_prune_5}, 'file' ), '' ), '->remove(noprune) returns true' );
722		ok( -d $f{remove_prune_5}, '->remove(noprune) leaves dir intact' );
723
724		# Make sure there's no warning with undef false value
725		ok( File::Flat->remove( catdir( $f{remove_prune_6}, 'file' ), undef ), '->remove(noprune) returns true' );
726		ok( -d $f{remove_prune_6}, '->remove(noprune) leaves dir intact' );
727
728		exit();
729
730
731
732
733
734		sub check_content_file {
735		my $file = shift;
736		return undef unless -e $file;
737		return undef unless -r $file;
738
739		open( FILE, $file ) or return undef;
740		@content = <FILE>;
741		chomp @content;
742		close FILE;
743
744		return undef unless scalar @content == 4;
745		return undef unless $content[0] eq 'one';
746		return undef unless $content[1] eq 'two';
747		return undef unless $content[2] eq 'three';
748		return undef unless $content[3] eq '';
749
750		return 1;
751		}
752
753		END {
754		# When we finish there are going to be some pretty fucked up files.
755		# Make them less so.
756		foreach my $clean1 ( qw{
757		0000 0100 0200 0300 0400 0500 0600 0700
758		ff_handle moved_1
759		write_1 write_2 write_3 write_4 write_5 write_6
760		over_1 over_2 over_3 over_4
761		append_1 append_2 append_3 append_4
762		size_1 size_2 size_3
763		trunc_1
764		} ) {
765		if ( -e $clean1 ) {
766		chmod 0600, $clean1;
767		unlink $clean1;
768		next;
769		}
770		my $clean2 = catfile( 't', $clean1 );
771		if ( -e $clean2 ) {
772		chmod 0600, $clean2;
773		unlink $clean2;
774		next;
775		}
776		}
777
778		foreach my $dir ( qw{a b baddir gooddir} ) {
779		next unless -e $f{$dir};
780		chmod_R( 0700, $f{$dir} );
781		remove \1, $f{$dir};
782		}
783
784		remove \1, $f{prune};
785		}

+786

-0

t/03_main.t less more

	0	#!/usr/bin/perl
	1
	2	# Formal testing for File::Flat
	3
	4	use strict;
	5	use File::Spec::Functions ':ALL';
	6	BEGIN {
	7	$\| = 1;
	8	$^W = 1;
	9	}
	10
	11	use File::Copy 'copy';
	12	use File::Remove 'remove';
	13	use File::Find 'find';
	14
	15	# If we are root, some things we WANT to fail won't,
	16	# and we'll have to skip some tests.
	17	use vars qw{$root $win32};
	18	BEGIN {
	19	$root = ($> == 0) ? 1 : 0;
	20	$win32 = ($^O eq 'MSWin32') ? 1 : 0;
	21	}
	22
	23	# cygwin permissions are insane, so lets treat everyone like
	24	# root and skip all the relevant tests.
	25	# we ALSO want to skip all the tests (mostly related to canExecute)
	26	# that fail on Win32.
	27	BEGIN {
	28	if ( $^O eq 'cygwin' ) {
	29	$root = 1;
	30	$win32 = 1;
	31	}
	32	}
	33
	34	use Test::More tests => 269;
	35
	36	# Set up any needed globals
	37	use vars qw{$loaded $ci $bad};
	38	use vars qw{$content_string @content_array $content_length};
	39	use vars qw{$curdir %f};
	40	BEGIN {
	41	$loaded = 0;
	42	$\| = 1;
	43	$content_string = "one\ntwo\nthree\n\n";
	44	@content_array = ( 'one', 'two', 'three', '' );
	45	$content_length = length $content_string;
	46
	47	# Define all the paths we are going to need in advance
	48	$curdir = curdir();
	49	%f = (
	50	null => catfile( $curdir, 'null' ),
	51	something => catfile( $curdir, 'something' ),
	52
	53	rwx => catfile( $curdir, '0000' ),
	54	Rwx => catfile( $curdir, '0400' ),
	55	rWx => catfile( $curdir, '0200' ),
	56	rwX => catfile( $curdir, '0100' ),
	57	RWx => catfile( $curdir, '0600' ),
	58	RwX => catfile( $curdir, '0500' ),
	59	rWX => catfile( $curdir, '0300' ),
	60	RWX => catfile( $curdir, '0700' ),
	61	gooddir => catdir( $curdir, 'gooddir' ),
	62	baddir => catdir( $curdir, 'baddir' ),
	63
	64	ff_handle => catfile( $curdir, 't', 'ff_handle' ),
	65	ff_binary => catfile( $curdir, 't', 'ff_binary' ),
	66	ff_text => catfile( $curdir, 't', 'ff_text' ),
	67	ff_content => catfile( $curdir, 't', 'ff_content' ),
	68
	69	ff_content2 => catfile( $curdir, 'ff_content2' ),
	70	a_ff_text3 => catfile( $curdir, 'a', 'ff_text3' ),
	71	abcde_ff_text3 => catfile( $curdir, 'a', 'b', 'c', 'd', 'e', 'ff_text3' ),
	72	abdde_ff_text3 => catfile( $curdir, 'a', 'b', 'd', 'd', 'e', 'ff_text3' ),
	73	abc => catdir( $curdir, 'a', 'b', 'c' ),
	74	abd => catdir( $curdir, 'a', 'b', 'd' ),
	75	a => catdir( $curdir, 'a' ),
	76	b => catdir( $curdir, 'b' ),
	77
	78	moved_1 => catfile( $curdir, 'moved_1' ),
	79	moved_2 => catfile( $curdir, 'b', 'c', 'd', 'e', 'moved_2' ),
	80
	81	write_1 => catfile( $curdir, 'write_1' ),
	82	write_2 => catfile( $curdir, 'write_2' ),
	83	write_3 => catfile( $curdir, 'write_3' ),
	84	write_4 => catfile( $curdir, 'write_4' ),
	85	write_5 => catfile( $curdir, 'write_5' ),
	86	write_6 => catfile( $curdir, 'write_6' ),
	87
	88	over_1 => catfile( $curdir, 'over_1' ),
	89	over_2 => catfile( $curdir, 'over_2' ),
	90	over_3 => catfile( $curdir, 'over_3' ),
	91	over_4 => catfile( $curdir, 'over_4' ),
	92
	93	append_1 => catfile( $curdir, 'append_1' ),
	94	append_2 => catfile( $curdir, 'append_2' ),
	95	append_3 => catfile( $curdir, 'append_3' ),
	96	append_4 => catfile( $curdir, 'append_4' ),
	97
	98	size_1 => catfile( $curdir, 'size_1' ),
	99	size_2 => catfile( $curdir, 'size_2' ),
	100	size_3 => catfile( $curdir, 'size_3' ),
	101
	102	trunc_1 => catfile( $curdir, 'trunc_1' ),
	103
	104	prune => catdir( $curdir, 'prunedir' ),
	105	prune_1 => catdir( $curdir, 'prunedir', 'single' ),
	106	prune_2 => catdir( $curdir, 'prunedir', 'multiple', 'lots', 'of', 'dirs' ),
	107	prune_2a => catdir( $curdir, 'prunedir', 'multiple' ),
	108	prune_3 => catdir( $curdir, 'prunedir', 'onlyone', 'thisone' ),
	109	prune_4 => catdir( $curdir, 'prunedir', 'onlyone', 'notthis' ),
	110	prune_4a => catdir( $curdir, 'prunedir', 'onlyone' ),
	111	prune_5 => catdir( $curdir, 'prunedir', 'onlyone', 'notthis', 'orthis' ),
	112
	113	remove_prune_1 => catfile( $curdir, 'prunedir', 'remove', 'prune_1' ),
	114	remove_prune_2 => catfile( $curdir, 'prunedir', 'remove', 'prune_2' ),
	115	remove_prune_3 => catfile( $curdir, 'prunedir', 'remove', 'prune_3' ),
	116	remove_prune_4 => catfile( $curdir, 'prunedir', 'remove', 'prune_4' ),
	117	remove_prune_5 => catfile( $curdir, 'prunedir', 'remove', 'prune_5' ),
	118	remove_prune_6 => catfile( $curdir, 'prunedir', 'remove', 'prune_6' ),
	119	);
	120
	121	# Avoid some 'only used once' warnings
	122	$File::Flat::errstr = $File::Flat::errstr;
	123	$File::Flat::AUTO_PRUNE = $File::Flat::AUTO_PRUNE;
	124	}
	125
	126	# Convenience functions to avoid system calls
	127	sub touch_test_file($) {
	128	# Do the 'touch' part
	129	my $file = catfile( $curdir, $_[0] );
	130	open FILE, ">>$file" or return undef;
	131	close FILE;
	132
	133	# And now the chmod part
	134	my $mask = oct($_[0]);
	135	chmod $mask, $file or return undef;
	136
	137	1;
	138	}
	139
	140	sub chmod_R($$) {
	141	my($mask, $dir) = @_;
	142	chmod $mask, $dir;
	143	find( sub { chmod $mask, $File::Find::name }, $dir );
	144	}
	145
	146	# Check their perl version, and that modules are installed
	147	ok( $] >= 5.005, "Your perl is new enough" );
	148	use_ok( 'File::Flat' );
	149
	150
	151
	152
	153	# Check for the three files that should already exist
	154	ok( -f $f{ff_text}, 'ff_text exists' );
	155	ok( -f $f{ff_binary}, 'ff_binary exists' );
	156	ok( -f $f{ff_content}, 'ff_content exists' );
	157
	158	# Create the files for the file test section
	159	touch_test_file('0000') or die "Failed to create file we can do anything to";
	160	touch_test_file('0400') or die "Failed to create file we can only read";
	161	touch_test_file('0200') or die "Failed to create file we can only write";
	162	touch_test_file('0100') or die "Failed to create file we can only execute";
	163	touch_test_file('0600') or die "Failed to create file we can read and write";
	164	touch_test_file('0500') or die "Failed to create file we can read and execute";
	165	touch_test_file('0300') or die "Failed to create file we can write and execute";
	166	touch_test_file('0700') or die "Failed to create file we can read, write and execute";
	167
	168	unless ( chmod 0777, $curdir ) {
	169	die "Failed to set current directory to mode 777";
	170	}
	171	unless ( -e $f{gooddir} ) {
	172	unless ( mkdir $f{gooddir}, 0755 ) {
	173	die "Failed to create mode 0755 directory";
	174	}
	175	}
	176	unless ( -e $f{baddir} ) {
	177	unless ( mkdir $f{baddir}, 0000 ) {
	178	die "Failed to create mode 0000 directory";
	179	}
	180	}
	181
	182	# We are also going to use a file called "./null" to represent
	183	# a file that doesn't exist.
	184
	185
	186
	187	### Test Section 1
	188	# Here we will test all the static methods that are handled directly, and
	189	# not passed on to the object form of the methods.
	190
	191	# Test the error message handling
	192	my $error_message = 'foo';
	193	my $rv = File::Flat->_error( $error_message );
	194	ok( ! defined $rv, "->_error returns undef" );
	195	ok( $File::Flat::errstr eq $error_message, "->_error sets error message" );
	196	ok( File::Flat->errstr eq $error_message, "->errstr retrieves error message" );
	197
	198	# Test the static ->exists method
	199	ok( ! File::Flat->exists( $f{null} ), "Static ->exists doesn't see missing file" );
	200	ok( File::Flat->exists( $f{rwx} ), "Static ->exists sees mode 000 file" );
	201	ok( File::Flat->exists( $f{Rwx} ), "Static ->exists sees mode 400 file" );
	202	ok( File::Flat->exists( $f{RWX} ), "Static ->exists sees mode 700 file" );
	203	ok( File::Flat->exists( $curdir ), "Static ->exists sees . directory" );
	204	ok( File::Flat->exists( $f{baddir} ), "Static ->exists sees mode 000 directory" );
	205
	206	# Test the static ->isaFile method
	207	ok( ! File::Flat->isaFile( $f{null} ), "Static ->isaFile returns false for missing file" );
	208	ok( File::Flat->isaFile( $f{rwx} ), "Static ->isaFile returns true for mode 000 file" );
	209	ok( File::Flat->isaFile( $f{RWX} ), "Static ->isaFile returns true for mode 700 file" );
	210	ok( ! File::Flat->isaFile( $curdir ), "Static ->isaFile returns false for current directory" );
	211	ok( ! File::Flat->isaFile( $f{gooddir} ), "Static ->isaFile returns false for subdirectory" );
	212
	213	# Test the static ->isaDirectory method
	214	ok( ! File::Flat->isaDirectory( $f{null} ), "Static ->isaDirectory returns false for missing directory" );
	215	ok( ! File::Flat->isaDirectory( $f{rwx} ), "Static ->isaDirectory returns false for mode 000 file" );
	216	ok( ! File::Flat->isaDirectory( $f{RWX} ), "Static ->isaDirectory returns false for mode 700 file" );
	217	ok( File::Flat->isaDirectory( $curdir ), "Static ->isaDirectory returns true for current directory" );
	218	ok( File::Flat->isaDirectory( $f{gooddir} ), "Static ->isaDirectory returns true for readable subdirectory" );
	219	ok( File::Flat->isaDirectory( $f{baddir} ), "Static ->isaDirectory return true for unreadable subdirectory" );
	220
	221	# Test the static ->canRead method
	222	ok( ! File::Flat->canRead( $f{null} ), "Static ->canRead returns false for missing file" );
	223	SKIP: {
	224	skip "Skipping tests known to fail for root", 1 if $root;
	225	ok( ! File::Flat->canRead( $f{rwx} ), "Static ->canRead returns false for mode 000 file" );
	226	}
	227	ok( File::Flat->canRead( $f{Rwx} ), "Static ->canRead returns true for mode 400 file" );
	228	SKIP: {
	229	skip "Skipping tests known to fail for root", 2 if $root;
	230	ok( ! File::Flat->canRead( $f{rWx} ), "Static ->canRead returns false for mode 200 file" );
	231	ok( ! File::Flat->canRead( $f{rwX} ), "Static ->canRead returns false for mode 100 file" );
	232	}
	233	ok( File::Flat->canRead( $f{RWx} ), "Static ->canRead returns true for mode 500 file" );
	234	ok( File::Flat->canRead( $f{RwX} ), "Static ->canRead returns true for mode 300 file" );
	235	ok( File::Flat->canRead( $f{RWX} ), "Static ->canRead returns true for mode 700 file" );
	236	ok( File::Flat->canRead( $curdir ), "Static ->canRead returns true for current directory" );
	237	ok( File::Flat->canRead( $f{gooddir} ), "Static ->canRead returns true for readable subdirectory" );
	238	SKIP: {
	239	skip "Skipping tests known to fail for root", 1 if $root;
	240	ok( ! File::Flat->canRead( $f{baddir} ), "Static ->canRead returns false for unreadable subdirectory" );
	241	}
	242
	243
	244	# Test the static ->canWrite method
	245	ok( File::Flat->canWrite( $f{null} ), "Static ->canWrite returns true for missing, creatable, file" );
	246	SKIP: {
	247	skip "Skipping tests known to fail for root", 2 if $root;
	248	ok( ! File::Flat->canWrite( $f{rwx} ), "Static ->canWrite returns false for mode 000 file" );
	249	ok( ! File::Flat->canWrite( $f{Rwx} ), "Static ->canWrite returns false for mode 400 file" );
	250	}
	251	ok( File::Flat->canWrite( $f{rWx} ), "Static ->canWrite returns true for mode 200 file" );
	252	SKIP: {
	253	skip "Skipping tests known to fail for root", 1 if $root;
	254	ok( ! File::Flat->canWrite( $f{rwX} ), "Static ->canWrite returns false for mode 100 file" );
	255	}
	256	ok( File::Flat->canWrite( $f{RWx} ), "Static ->canWrite returns true for mode 500 file" );
	257	SKIP: {
	258	skip "Skipping tests known to fail for root", 1 if $root;
	259	ok( ! File::Flat->canWrite( $f{RwX} ), "Static ->canWrite returns false for mode 300 file" );
	260	}
	261	ok( File::Flat->canWrite( $f{RWX} ), "Static ->canWrite returns true for mode 700 file" );
	262	ok( File::Flat->canWrite( $curdir ), "Static ->canWrite returns true for current directory" );
	263	ok( File::Flat->canWrite( $f{gooddir} ), "Static ->canWrite returns true for writable subdirectory" );
	264	SKIP: {
	265	skip "Skipping tests known to fail for root", 2 if $root;
	266	ok( ! File::Flat->canWrite( $f{baddir} ), "Static ->canWrite returns false for unwritable subdirectory" );
	267	ok( ! File::Flat->canWrite( catfile($f{baddir}, 'file') ), "Static ->canWrite returns false for missing, non-creatable file" );
	268	}
	269
	270	# Test the static ->canReadWrite method
	271	ok( ! File::Flat->canReadWrite( $f{null} ), "Static ->canReadWrite returns false for missing file" );
	272	SKIP: {
	273	skip "Skipping tests known to fail for root", 4 if $root;
	274	ok( ! File::Flat->canReadWrite( $f{rwx} ), "Static ->canReadWrite returns false for mode 000 file" );
	275	ok( ! File::Flat->canReadWrite( $f{Rwx} ), "Static ->canReadWrite returns false for mode 400 file" );
	276	ok( ! File::Flat->canReadWrite( $f{rWx} ), "Static ->canReadWrite returns false for mode 200 file" );
	277	ok( ! File::Flat->canReadWrite( $f{rwX} ), "Static ->canReadWrite returns false for mode 100 file" );
	278	}
	279	ok( File::Flat->canReadWrite( $f{RWx} ), "Static ->canReadWrite returns true for mode 500 file" );
	280	SKIP: {
	281	skip "Skipping tests known to fail for root", 1 if $root;
	282	ok( ! File::Flat->canReadWrite( $f{RwX} ), "Static ->canReadWrite returns false for mode 300 file" );
	283	}
	284	ok( File::Flat->canReadWrite( $f{RWX} ), "Static ->canReadWrite returns true for mode 700 file" );
	285	ok( File::Flat->canReadWrite( $curdir ), "Static ->canReadWrite returns true for current directory" );
	286	ok( File::Flat->canReadWrite( $f{gooddir} ), "Static ->canReadWrite returns true for readwritable subdirectory" );
	287	SKIP: {
	288	skip "Skipping tests known to fail for root", 1 if $root;
	289	ok( ! File::Flat->canReadWrite( $f{baddir} ), "Static ->canReadWrite returns false for unreadwritable subdirectory" );
	290	}
	291
	292	# Test the static ->canExecute method
	293	SKIP: {
	294	skip( "Skipping tests known to falsely fail on Win32", 11 ) if $win32;
	295
	296	ok( ! File::Flat->canExecute( $f{null} ), "Static ->canExecute returns false for missing file" );
	297	ok( ! File::Flat->canExecute( $f{rwx} ), "Static ->canExecute returns false for mode 000 file" );
	298	ok( ! File::Flat->canExecute( $f{Rwx} ), "Static ->canExecute returns false for mode 400 file" );
	299	ok( ! File::Flat->canExecute( $f{rWx} ), "Static ->canExecute returns false for mode 200 file" );
	300	ok( File::Flat->canExecute( $f{rwX} ), "Static ->canExecute returns true for mode 100 file" );
	301	ok( ! File::Flat->canExecute( $f{RWx} ), "Static ->canExecute returns false for mode 500 file" );
	302	ok( File::Flat->canExecute( $f{RwX} ), "Static ->canExecute returns true for mode 300 file" );
	303	ok( File::Flat->canExecute( $f{RWX} ), "Static ->canExecute returns true for mode 700 file" );
	304	ok( File::Flat->canExecute( $curdir ), "Static ->canExecute returns true for current directory" );
	305	ok( File::Flat->canExecute( $f{gooddir} ), "Static ->canExecute returns true for executable subdirectory" );
	306
	307	skip( "Skipping tests known to falsely fail for root", 1 ) if $root;
	308	ok( ! File::Flat->canExecute( $f{baddir} ), "Static ->canExecute returns false for unexecutable subdirectory" );
	309	}
	310
	311	# Test the static ->canOpen method
	312	ok( ! File::Flat->canOpen( $f{null} ), "Static ->canOpen returns false for missing file" );
	313	SKIP: {
	314	skip "Skipping tests known to fail for root", 1 if $root;
	315	ok( ! File::Flat->canOpen( $f{rwx} ), "Static ->canOpen returns false for mode 000 file" );
	316	}
	317	ok( File::Flat->canOpen( $f{Rwx} ), "Static ->canOpen returns true for mode 400 file" );
	318	SKIP: {
	319	skip "Skipping tests known to fail for root", 2 if $root;
	320	ok( ! File::Flat->canOpen( $f{rWx} ), "Static ->canOpen returns false for mode 200 file" );
	321	ok( ! File::Flat->canOpen( $f{rwX} ), "Static ->canOpen returns false for mode 100 file" );
	322	}
	323	ok( File::Flat->canOpen( $f{RWx} ), "Static ->canOpen returns true for mode 500 file" );
	324	ok( File::Flat->canOpen( $f{RwX} ), "Static ->canOpen returns true for mode 300 file" );
	325	ok( File::Flat->canOpen( $f{RWX} ), "Static ->canOpen returns true for mode 700 file" );
	326	ok( ! File::Flat->canOpen( $curdir ), "Static ->canOpen returns false for current directory" );
	327	ok( ! File::Flat->canOpen( $f{gooddir} ), "Static ->canOpen returns false for readable subdirectory" );
	328	ok( ! File::Flat->canOpen( $f{baddir} ), "Static ->canOpen returns false for unreadable subdirectory" );
	329
	330	# Test the existance of normal and/or binary files
	331	ok( ! File::Flat->isText( $f{null} ), "Static ->isText returns false for missing file" );
	332	ok( ! File::Flat->isText( $f{ff_binary} ), "Static ->isText returns false for binary file" );
	333	ok( File::Flat->isText( $f{ff_text} ), "Static ->isText returns true for text file" );
	334	ok( ! File::Flat->isText( $f{gooddir} ), "Static ->isText returns false for good subdirectory" );
	335	ok( ! File::Flat->isText( $f{baddir} ), "Static ->isText returns false for bad subdirectory" );
	336	ok( ! File::Flat->isBinary( $f{null} ), "Static ->isBinary returns false for missing file" );
	337	ok( File::Flat->isBinary( $f{ff_binary} ), "Static ->isBinary returns true for binary file" );
	338	ok( ! File::Flat->isBinary( $f{ff_text} ), "Static ->isBinary returns false for text file" );
	339	ok( ! File::Flat->isBinary( $f{gooddir} ), "Static ->isBinary return false for good subdirectory" );
	340	ok( ! File::Flat->isBinary( $f{baddir} ), "Static ->isBinary returns false for bad subdirectory" );
	341
	342	my %handle = ();
	343
	344	# Do open handle methods return false for bad values
	345	$handle{generic} = File::Flat->open( $f{null} );
	346	$handle{readhandle} = File::Flat->open( $f{null} );
	347	$handle{writehandle} = File::Flat->open( $f{null} );
	348	$handle{appendhandle} = File::Flat->open( $f{null} );
	349	$handle{readwritehandle} = File::Flat->open( $f{null} );
	350	ok( ! defined $handle{generic}, "Static ->open call returns undef on bad file name" );
	351	ok( ! defined $handle{readhandle}, "Static ->getReadHandle returns undef on bad file name" );
	352	ok( ! defined $handle{writehandle}, "Static ->getWriteHandle returns undef on bad file name" );
	353	ok( ! defined $handle{appendhandle}, "Static ->getAppendHandle returns undef on bad file name" );
	354	ok( ! defined $handle{readwritehandle}, "Static ->getReadWriteHandle returns undef on bad file name" );
	355
	356	# Do the open methods at least return a file handle
	357	copy( $f{ff_text}, $f{ff_handle} ) or die "Failed to copy file in preperation for test";
	358	$handle{generic} = File::Flat->open( $f{ff_handle} );
	359	$handle{readhandle} = File::Flat->getReadHandle( $f{ff_handle} );
	360	$handle{writehandle} = File::Flat->getWriteHandle( $f{ff_handle} );
	361	$handle{appendhandle} = File::Flat->getAppendHandle( $f{ff_handle} );
	362	$handle{readwritehandle} = File::Flat->getReadWriteHandle( $f{ff_handle} );
	363	isa_ok( $handle{generic}, 'IO::File' ); # Static ->open call returns IO::File object
	364	isa_ok( $handle{readhandle}, 'IO::File' ); # Static ->getReadHandle returns IO::File object
	365	isa_ok( $handle{writehandle}, 'IO::File' ); # Static ->getWriteHandle returns IO::File object
	366	isa_ok( $handle{appendhandle}, 'IO::File' ); # Static ->getAppendHandle returns IO::File object
	367	isa_ok( $handle{readwritehandle}, 'IO::File' ); # Static ->getReadWriteHandle returns IO::File object
	368
	369
	370
	371
	372
	373
	374	# Test the static ->copy method
	375	ok( ! defined File::Flat->copy(), '->copy() returns error' );
	376	ok( ! defined File::Flat->copy( $f{ff_content} ), '->copy( file ) returns error' );
	377
	378	$rv = File::Flat->copy( $f{ff_content}, $f{ff_content2} );
	379	ok( $rv, "Static ->copy returns true correctly for same directory copy" );
	380	ok( -e $f{ff_content2}, "Static ->copy actually created the file for same directory copy" );
	381	ok( check_content_file( $f{ff_content2} ), "Static ->copy copies the file without breaking it" );
	382
	383	$rv = File::Flat->copy( $f{ff_text}, $f{a_ff_text3} );
	384	ok( $rv, "Static ->copy returns true correctly for single sub-directory copy" );
	385	ok( -e $f{a_ff_text3}, "Static ->copy actually created the file for single sub-directory copy" );
	386
	387	$rv = File::Flat->copy( $f{ff_text}, $f{abcde_ff_text3} );
	388	ok( $rv, "Static ->copy returns true correctly for multiple sub-directory copy" );
	389	ok( -e $f{abcde_ff_text3}, "Static ->copy actually created the file for multiple sub-directory copy" );
	390
	391	$rv = File::Flat->copy( $f{null}, $f{something} );
	392	ok( ! $rv, "Static ->copy return undef when file does not exist" );
	393
	394	# Directory copying
	395	$rv = File::Flat->copy( $f{abc}, $f{abd} );
	396	SKIP: {
	397	skip "Skipping tests known to fail for root", 1 if $root;
	398	ok( $rv, '->copy( dir, dir ) returns true' );
	399	}
	400	ok( -d $f{abd}, '->copy( dir, dir ): New dir exists' );
	401	ok( -f $f{abdde_ff_text3}, '->copy( dir, dir ): Files within directory were copied' );
	402
	403	# Test the static ->move method
	404	$rv = File::Flat->move( $f{abcde_ff_text3}, $f{moved_1} );
	405	ok( $rv, "Static ->move for move to existing directory returns true " );
	406	ok( ! -e $f{abcde_ff_text3}, "Static ->move for move to existing directory actually removes the old file" );
	407	ok( -e $f{moved_1}, "Static ->move for move to existing directory actually creates the new file" );
	408
	409	$rv = File::Flat->move( $f{ff_content2}, $f{moved_2} );
	410	ok( $rv, "Static ->move for move to new directory returns true " );
	411	ok( ! -e $f{ff_content2}, "Static ->move for move to new directory actually removes the old file" );
	412	ok( -e $f{moved_2}, "Static ->move for move to new directory actually creates the new file" );
	413	ok( check_content_file( $f{moved_2} ), "Static ->move moved the file without breaking it" );
	414
	415
	416
	417
	418
	419
	420	# Test the static ->slurp method
	421	ok( check_content_file( $f{ff_content} ), "Content tester works" );
	422	my $content = File::Flat->slurp();
	423	ok( ! defined $content, "Static ->slurp returns error on no arguments" );
	424	$content = File::Flat->slurp( $f{null} );
	425	ok( ! defined $content, "Static ->slurp returns error on bad file" );
	426	$content = File::Flat->slurp( $f{ff_content} );
	427	ok( defined $content, "Static ->slurp returns defined" );
	428	ok( defined $content, "Static ->slurp returns something" );
	429	ok( UNIVERSAL::isa( $content, 'SCALAR' ), "Static ->slurp returns a scalar reference" );
	430	ok( length $$content, "Static ->slurp returns content" );
	431	ok( $$content eq $content_string, "Static ->slurp returns the correct file contents" );
	432
	433	# Test the static ->read
	434	$content = File::Flat->read();
	435	ok( ! defined $content, "Static ->read returns error on no arguments" );
	436	$content = File::Flat->read( $f{null} );
	437	ok( ! defined $content, "Static ->read returns error on bad file" );
	438	$content = File::Flat->read( $f{ff_content} );
	439	ok( defined $content, "Static ->read doesn't error on good file" );
	440	ok( $content, "Static ->read returns true on good file" );
	441	ok( ref $content, "Static ->read returns a reference on good file" );
	442	ok( UNIVERSAL::isa( $content, 'ARRAY' ), "Static ->read returns an array ref on good file" );
	443	ok( scalar @$content == 4, "Static ->read returns the correct length of data" );
	444	my $matches = (
	445	$content->[0] eq 'one'
	446	and $content->[1] eq 'two'
	447	and $content->[2] eq 'three'
	448	and $content->[3] eq ''
	449	) ? 1 : 0;
	450	ok( $matches, "Static ->read returns the expected content" );
	451
	452	# And again in an array context
	453	my @content = File::Flat->read();
	454	ok( ! scalar @content, "Static ->read (array context) returns error on no arguments" );
	455	@content = File::Flat->read( $f{null} );
	456	ok( ! scalar @content, "Static ->read (array context) returns error on bad file" );
	457	@content = File::Flat->read( $f{ff_content} );
	458	ok( scalar @content, "Static ->read (array context) doesn't error on good file" );
	459	ok( scalar @content == 4, "Static ->read (array context) returns the correct length of data" );
	460	$matches = (
	461	$content[0] eq 'one'
	462	and $content[1] eq 'two'
	463	and $content[2] eq 'three'
	464	and $content[3] eq ''
	465	) ? 1 : 0;
	466	ok( $matches, "Static ->read (array context) returns the expected content" );
	467
	468
	469
	470
	471
	472	# Test the many and varies write() options.
	473	ok( ! File::Flat->write(), "->write() fails correctly" );
	474	ok( ! File::Flat->write( $f{write_1} ), "->write( file ) fails correctly" );
	475	ok( ! -e $f{write_1}, "->write( file ) doesn't actually create a file" );
	476
	477	$rv = File::Flat->write( $f{write_1}, $content_string );
	478	ok( $rv, "->File::Flat->write( file, string ) returns true" );
	479	ok( -e $f{write_1}, "->write( file, string ) actually creates a file" );
	480	ok( check_content_file( $f{write_1} ), "->write( file, string ) writes the correct content" );
	481
	482	$rv = File::Flat->write( $f{write_2}, $content_string );
	483	ok( $rv, "->File::Flat->write( file, string_ref ) returns true" );
	484	ok( -e $f{write_2}, "->write( file, string_ref ) actually creates a file" );
	485	ok( check_content_file( $f{write_2} ), "->write( file, string_ref ) writes the correct content" );
	486
	487	$rv = File::Flat->write( $f{write_3}, \@content_array );
	488	ok( $rv, "->write( file, array_ref ) returns true" );
	489	ok( -e $f{write_3}, "->write( file, array_ref ) actually creates a file" );
	490	ok( check_content_file( $f{write_3} ), "->write( file, array_ref ) writes the correct content" );
	491
	492	# Repeat with a handle first argument
	493	my $handle = File::Flat->getWriteHandle( $f{write_4} );
	494	ok( ! File::Flat->write( $handle ), "->write( handle ) fails correctly" );
	495	ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
	496	$rv = File::Flat->write( $handle, $content_string );
	497	$handle->close();
	498	ok( $rv, "->write( handle, string ) returns true" );
	499	ok( -e $f{write_4}, "->write( handle, string ) actually creates a file" );
	500	ok( check_content_file( $f{write_1} ), "->write( handle, string ) writes the correct content" );
	501
	502	$handle = File::Flat->getWriteHandle( $f{write_5} );
	503	ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
	504	$rv = File::Flat->write( $handle, $content_string );
	505	$handle->close();
	506	ok( $rv, "->File::Flat->write( handle, string_ref ) returns true" );
	507	ok( -e $f{write_5}, "->write( handle, string_ref ) actually creates a file" );
	508	ok( check_content_file( $f{write_5} ), "->write( handle, string_ref ) writes the correct content" );
	509
	510	$handle = File::Flat->getWriteHandle( $f{write_6} );
	511	ok( UNIVERSAL::isa( $handle, 'IO::Handle' ), 'Got write handle for test' );
	512	$rv = File::Flat->write( $handle, \@content_array );
	513	$handle->close();
	514	ok( $rv, "->File::Flat->write( handle, array_ref ) returns true" );
	515	ok( -e $f{write_6}, "->write( handle, array_ref ) actually creates a file" );
	516	ok( check_content_file( $f{write_6} ), "->write( handle, array_ref ) writes the correct content" );
	517
	518
	519
	520
	521
	522
	523	# Check the ->overwrite method
	524	ok( ! File::Flat->overwrite(), "->overwrite() fails correctly" );
	525	ok( ! File::Flat->overwrite( $f{over_1} ), "->overwrite( file ) fails correctly" );
	526	ok( ! -e $f{over_1}, "->overwrite( file ) doesn't actually create a file" );
	527
	528	$rv = File::Flat->overwrite( $f{over_1}, $content_string );
	529	ok( $rv, "->File::Flat->overwrite( file, string ) returns true" );
	530	ok( -e $f{over_1}, "->overwrite( file, string ) actually creates a file" );
	531	ok( check_content_file( $f{over_1} ), "->overwrite( file, string ) writes the correct content" );
	532
	533	$rv = File::Flat->overwrite( $f{over_2}, $content_string );
	534	ok( $rv, "->File::Flat->overwrite( file, string_ref ) returns true" );
	535	ok( -e $f{over_2}, "->overwrite( file, string_ref ) actually creates a file" );
	536	ok( check_content_file( $f{over_2} ), "->overwrite( file, string_ref ) writes the correct content" );
	537
	538	$rv = File::Flat->overwrite( $f{over_3}, \@content_array );
	539	ok( $rv, "->overwrite( file, array_ref ) returns true" );
	540	ok( -e $f{over_3}, "->overwrite( file, array_ref ) actually creates a file" );
	541	ok( check_content_file( $f{over_3} ), "->overwrite( file, array_ref ) writes the correct content" );
	542
	543	# Check actually overwriting a file
	544	ok ( File::Flat->copy( $f{ff_text}, $f{over_4} ), "Preparing for overwrite test" );
	545	$rv = File::Flat->overwrite( $f{over_4}, \$content_string );
	546	ok( $rv, "->overwrite( file, array_ref ) returns true" );
	547	ok( -e $f{over_4}, "->overwrite( file, array_ref ) actually creates a file" );
	548	ok( check_content_file( $f{over_4} ), "->overwrite( file, array_ref ) writes the correct content" );
	549
	550
	551
	552
	553
	554	# Check the basics of the ->remove method
	555	ok( ! File::Flat->remove(), "->remove() correctly return an error" );
	556	ok( ! File::Flat->remove( $f{null} ), "->remove( file ) returns an error for a nonexistant file" );
	557	ok( File::Flat->remove( $f{over_4} ), "->remove( file ) returns true for existing file" );
	558	ok( ! -e $f{over_4}, "->remove( file ) actually removes the file" );
	559	ok( File::Flat->remove( $f{a} ), "->remove( directory ) returns true for existing directory" );
	560	ok( ! -e $f{a}, "->remove( directory ) actually removes the directory" );
	561
	562
	563
	564
	565
	566	# Check the append method
	567	ok( ! File::Flat->append(), "->append() correctly returns an error" );
	568	ok( ! File::Flat->append( $f{append_1} ), "->append( file ) correctly returns an error" );
	569	ok( ! -e $f{append_1}, "->append( file ) doesn't actually create a file" );
	570
	571	$rv = File::Flat->append( $f{append_1}, $content_string );
	572	ok( $rv, "->File::Flat->append( file, string ) returns true" );
	573	ok( -e $f{append_1}, "->append( file, string ) actually creates a file" );
	574	ok( check_content_file( $f{append_1} ), "->append( file, string ) writes the correct content" );
	575
	576	$rv = File::Flat->append( $f{append_2}, $content_string );
	577	ok( $rv, "->File::Flat->append( file, string_ref ) returns true" );
	578	ok( -e $f{append_2}, "->append( file, string_ref ) actually creates a file" );
	579	ok( check_content_file( $f{append_2} ), "->append( file, string_ref ) writes the correct content" );
	580
	581	$rv = File::Flat->append( $f{append_3}, \@content_array );
	582	ok( $rv, "->append( file, array_ref ) returns true" );
	583	ok( -e $f{append_3}, "->append( file, array_ref ) actually creates a file" );
	584	ok( check_content_file( $f{append_3} ), "->append( file, array_ref ) writes the correct content" );
	585
	586	# Now let's try an actual append
	587	ok( File::Flat->append( $f{append_4}, "one\ntwo\n" ), "Preparing for real append" );
	588	$rv = File::Flat->append( $f{append_4}, "three\n\n" );
	589	ok( $rv, "->append( file, array_ref ) for an actual append returns true" );
	590	ok( -e $f{append_4}, "->append( file, array_ref ): File still exists" );
	591	ok( check_content_file( $f{append_4} ), "->append( file, array_ref ) results in the correct file contents" );
	592
	593
	594
	595
	596
	597	# Test the ->fileSize method
	598	ok( File::Flat->write( $f{size_1}, 'abcdefg' )
	599	&& File::Flat->write( $f{size_2}, join '', ( 'd' x 100000 ) )
	600	&& File::Flat->write( $f{size_3}, '' ),
	601	"Preparing for file size tests"
	602	);
	603	ok( ! defined File::Flat->fileSize(), "->fileSize() correctly returns error" );
	604	ok( ! defined File::Flat->fileSize( $f{null} ), '->fileSize( file ) returns error for nonexistant file' );
	605	ok( ! defined File::Flat->fileSize( $f{a} ), '->fileSize( directory ) returns error' );
	606	$rv = File::Flat->fileSize( $f{size_1} );
	607	ok( defined $rv, "->fileSize( file ) returns true for small file" );
	608	ok( $rv == 7, "->fileSize( file ) returns the correct size for small file" );
	609	$rv = File::Flat->fileSize( $f{size_2} );
	610	ok( defined $rv, "->fileSize( file ) returns true for big file" );
	611	ok( $rv == 100000, "->fileSize( file ) returns the correct size for big file" );
	612	$rv = File::Flat->fileSize( $f{size_3} );
	613	ok( defined $rv, "->fileSize( file ) returns true for empty file" );
	614	ok( $rv == 0, "->fileSize( file ) returns the correct size for empty file" );
	615
	616
	617
	618
	619
	620
	621
	622	# Test the ->truncate method. Use the append files
	623	ok( ! defined File::Flat->truncate(), '->truncate() correctly returns error' );
	624	SKIP: {
	625	skip "Skipping tests known to fail for root", 1 if $root;
	626	ok( ! defined File::Flat->truncate( $f{rwx} ), '->truncate( file ) returns error when no permissions' );
	627	}
	628	ok( ! defined File::Flat->truncate( './b' ), '->truncate( directory ) returns error' );
	629	$rv = File::Flat->truncate( $f{trunc_1} );
	630	ok( $rv, '->truncate( file ) returns true for non-existant file' );
	631	ok( -e $f{trunc_1}, '->truncate( file ) creates new file' );
	632	ok( File::Flat->fileSize( $f{trunc_1} ) == 0, '->truncate( file ) creates file of 0 bytes' );
	633
	634	$rv = File::Flat->truncate( $f{append_1} );
	635	ok( $rv, '->truncate( file ) returns true for existing file' );
	636	ok( -e $f{append_1}, '->truncate( file ): File still exists' );
	637	ok( File::Flat->fileSize( $f{append_1} ) == 0, '->truncate( file ) truncates to 0 bytes' );
	638
	639	$rv = File::Flat->truncate( $f{append_2}, 0 );
	640	ok( $rv, '->truncate( file, 0 ) returns true for existing file' );
	641	ok( -e $f{append_2}, '->truncate( file, 0 ): File still exists' );
	642	ok( File::Flat->fileSize( $f{append_2} ) == 0, '->truncate( file, 0 ) truncates to 0 bytes' );
	643
	644	$rv = File::Flat->truncate( $f{append_3}, 5 );
	645	ok( $rv, '->truncate( file, 5 ) returns true for existing file' );
	646	ok( -e $f{append_3}, '->truncate( file, 5 ): File still exists' );
	647	ok( File::Flat->fileSize( $f{append_3} ) == 5, '->truncate( file, 5 ) truncates to 5 bytes' );
	648
	649
	650
	651
	652
	653	#####################################################################
	654	# Test the prune method
	655
	656	# Create the test directories
	657	foreach ( 1 .. 5 ) {
	658	my $directory = $f{"prune_$_"};
	659	ok( File::Flat->makeDirectory( $directory ), "Created test directory '$directory'" );
	660	}
	661
	662	# Prune beneath the single dir
	663	$rv = File::Flat->prune( catfile($f{prune_1}, 'file.txt') );
	664	ok( $rv, '->prune(single) returned true' );
	665	ok( ! -e $f{prune_1}, '->prune(single) removed the single' );
	666	ok( -d $f{prune}, '->prune(single) didn\'t remove the master prunedir' );
	667
	668	# Prune beneath the multiple dir
	669	$rv = File::Flat->prune( catfile($f{prune_2}, 'here') );
	670	ok( $rv, '->prune(multiple) returned true' );
	671	ok( ! -e $f{prune_2}, '->prune(multiple) removed the top dir' );
	672	ok( ! -e $f{prune_2a}, '->prune(multiple) removed all the dirs' );
	673	ok( -d $f{prune}, '->prune(multiple) didn\'t remove the master prunedir' );
	674
	675	# Prune stops correctly
	676	$rv = File::Flat->prune( catfile($f{prune_3}, 'foo') );
	677	ok( $rv, '->prune(branched) returned true' );
	678	ok( ! -e $f{prune_3}, '->prune(branched) removed the correct directory' );
	679	ok( -d $f{prune_4}, '->prune(branched) doesn\'t remove side directory' );
	680	ok( -d $f{prune}, '->prune(branched) didn\'t remove the master prunedir' );
	681
	682	# Don't prune anything
	683	$rv = File::Flat->prune( catfile($f{prune_4a}, 'blah') );
	684	ok( $rv, '->prune(nothing) returned true' );
	685	ok( -d $f{prune_4}, '->prune(nothing) doesn\'t remove side directory' );
	686	ok( -d $f{prune}, '->prune(nothing) didn\'t remove the master prunedir' );
	687
	688	# Error when used as delete
	689	$rv = File::Flat->prune( $f{prune_5} );
	690	is( $rv, undef, '->prune(existing) returns an error' );
	691	ok( File::Flat->errstr, '->prune(existing) sets ->errstr' );
	692
	693	# Test remove, with the prune option.
	694
	695	# Start by copying in some files to work with.
	696	# We'll use the last of the untouched append files
	697	foreach ( 1 .. 6 ) {
	698	ok( File::Flat->copy( $f{append_4}, catdir( $f{"remove_prune_$_"}, 'file' ) ), 'Copied in delete/prune test file' );
	699	}
	700
	701	# By default, AUTOPRUNE is off and we don't tell ->remove to prune
	702	ok( File::Flat->remove( catdir( $f{remove_prune_1}, 'file' ) ), '->remove(default) returns true' );
	703	ok( -d $f{remove_prune_1}, '->remove(default) leaves dir intact' );
	704
	705	# Try with AUTOPRUNE on
	706	AUTOPRUNE: {
	707	local $File::Flat::AUTO_PRUNE = 1;
	708	ok( File::Flat->remove( catdir( $f{remove_prune_2}, 'file' ) ), '->remove(AUTO_PRUNE) returns true' );
	709	ok( ! -e $f{remove_prune_2}, '->remove(AUTO_PRUNE) prunes directory' );
	710	}
	711
	712	# By default, AUTOPRUNE is off
	713	ok( File::Flat->remove( catdir( $f{remove_prune_3}, 'file' ) ), '->remove(default) returns true' );
	714	ok( -d $f{remove_prune_3}, '->remove(default) leaves dir intact (AUTO_PRUNE used locally localises correctly)' );
	715
	716	# Tell ->remove to prune
	717	ok( File::Flat->remove( catdir( $f{remove_prune_4}, 'file' ), 1 ), '->remove(prune) returns true' );
	718	ok( ! -e $f{remove_prune_4}, '->remove(AUTO_PRUNE) prunes directory' );
	719
	720	# Tell ->remove explicitly not to prune
	721	ok( File::Flat->remove( catdir( $f{remove_prune_5}, 'file' ), '' ), '->remove(noprune) returns true' );
	722	ok( -d $f{remove_prune_5}, '->remove(noprune) leaves dir intact' );
	723
	724	# Make sure there's no warning with undef false value
	725	ok( File::Flat->remove( catdir( $f{remove_prune_6}, 'file' ), undef ), '->remove(noprune) returns true' );
	726	ok( -d $f{remove_prune_6}, '->remove(noprune) leaves dir intact' );
	727
	728	exit();
	729
	730
	731
	732
	733
	734	sub check_content_file {
	735	my $file = shift;
	736	return undef unless -e $file;
	737	return undef unless -r $file;
	738
	739	open( FILE, $file ) or return undef;
	740	@content = <FILE>;
	741	chomp @content;
	742	close FILE;
	743
	744	return undef unless scalar @content == 4;
	745	return undef unless $content[0] eq 'one';
	746	return undef unless $content[1] eq 'two';
	747	return undef unless $content[2] eq 'three';
	748	return undef unless $content[3] eq '';
	749
	750	return 1;
	751	}
	752
	753	END {
	754	# When we finish there are going to be some pretty fucked up files.
	755	# Make them less so.
	756	foreach my $clean1 ( qw{
	757	0000 0100 0200 0300 0400 0500 0600 0700
	758	ff_handle moved_1
	759	write_1 write_2 write_3 write_4 write_5 write_6
	760	over_1 over_2 over_3 over_4
	761	append_1 append_2 append_3 append_4
	762	size_1 size_2 size_3
	763	trunc_1
	764	} ) {
	765	if ( -e $clean1 ) {
	766	chmod 0600, $clean1;
	767	unlink $clean1;
	768	next;
	769	}
	770	my $clean2 = catfile( 't', $clean1 );
	771	if ( -e $clean2 ) {
	772	chmod 0600, $clean2;
	773	unlink $clean2;
	774	next;
	775	}
	776	}
	777
	778	foreach my $dir ( qw{a b baddir gooddir} ) {
	779	next unless -e $f{$dir};
	780	chmod_R( 0700, $f{$dir} );
	781	remove \1, $f{$dir};
	782	}
	783
	784	remove \1, $f{prune};
	785	}