1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
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;
}
|
