use strict;
use warnings;
use Test::More tests => 17;
use Test::NoWarnings;
use File::Temp qw( tempdir );
use lib './lib';
use File::Util qw( SL NL existent OS );
my $f = File::Util->new();
my $tempdir = tempdir( CLEANUP => 1 );
my $testbed = $tempdir . SL . $$ . SL . time;
my $tmpf = $testbed . SL . 'tmptest';
my $have_perms = $f->is_writable( $tempdir );
my $testfh;
SKIP: {
if ( !$have_perms ) {
skip 'Insufficient permissions to perform IO in tempdir' => 16;
}
elsif ( !solaris_cooperates() ) {
skip 'Testing with an incooperative Solaris installation' => 16;
}
is $f->is_readable( $tempdir ),
-r '.',
'File::Util can tell if something is readable';
is $f->is_writable( $tempdir ),
-w '.',
'File::Util can tell if something is writable';
# this method "just is"... there's nothing to test; here for test coverage
is $f->last_changed( $tempdir ),
$f->last_changed( $tempdir ),
'File::Util can tell when a file was last changed';
# make a temporary testbed directory
is $f->make_dir( $testbed => { if_not_exists => 1 } ),
$testbed,
"make temp testbed in $testbed";
# see if it's there
is -e $testbed, 1, 'testbed created OK';
# ...again
is $f->existent( $testbed ), 1, 'File::Util agrees it exists';
# make a temporary file
is $f->write_file( file => $tmpf, content => 'LARRY' ), 1,
'write to a new text file' ;
# File::Util::touch() a file, and see if it was created ok
is(
sub {
my $tmpf = $testbed . SL . 'touched';
$f->touch( $tmpf );
my $result = $f->existent( $tmpf );
unlink $tmpf;
return $result;
}->(), 1, 'create an empty file via File::Util::touch()'
);
# get an open file handle
is(
sub {
$testfh = $f->open_handle(
file => $tmpf,
mode => 'append',
onfail => 'message',
warn_also => 1,
);
return ref $testfh
}->(), 'GLOB', 'get open file handle for appending'
);
# make sure it's still open
ok defined fileno $testfh, 'check if it has a fileno';
# write to it, close it, write to it in append mode
print $testfh 'WALL' and close $testfh;
# load file
is $f->load_file( $tmpf ), 'LARRYWALL', 'wrote to file OK';
# write to it with method File::Util::write_file(), compare file contents
# with the returned value
is(
sub {
$f->trunc( $tmpf ); # again, a solaris workaround
$f->write_file(
filename => $tmpf,
content => OS . NL
);
return $f->load_file( $tmpf );
}->(), OS . NL, 'write to a file with File::Util->write_file'
);
# get line count of file
is $f->line_count( $tmpf ), 1, 'line count of new file is right';
# truncate file
is sub { $f->trunc( $tmpf ); return -s $tmpf }->(), 0,
'truncate file, then make sure it is zero bytes';
# get line count of file
is $f->line_count( $tmpf ), 0, 'truncated file linecount is zero';
# big directory creation / removal sequence
my $newdir = $testbed
. SL . int( rand time )
. SL . int( rand time )
. SL . int( rand time )
. SL . int( rand time );
# 13
# make directories
is $f->make_dir( $newdir, '--if-not-exists' ),
$newdir, 'make a deep directory tree';
}
exit;
sub solaris_cooperates {
# we're only probing for solaris here, which has known issues
return 1 if $^O !~ /solaris|sunos/i;
my $tmpf = $tempdir . SL . 'solaris';
my $sf = File::Util->new( fatals_as_status => 1 );
my $fh = $sf->open_handle( file => $tmpf );
my $ok = fileno $fh ? 1 : 0;
close $fh if $ok;
unlink $tmpf if $ok;
$f->use_flock(0); # solaris flock is so broken, it might as well not exist
return $ok;
}