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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
#!/usr/local/bin/perl -w
# Test for File::Temp - tempfile function
use strict;
use Test::More tests => 28;
use File::Spec;
use Cwd qw/ cwd /;
# Will need to check that all files were unlinked correctly
# Set up an END block here to do it
# Arrays containing list of dirs/files to test
my (@files, @dirs, @still_there);
# And a test for files that should still be around
# These are tidied up
END {
foreach (@still_there) {
($_) = /(^.*)/; # untaint for testing under taint mode
ok( -f $_, "File $_ is still present" );
ok( unlink( $_ ), "Unlink file" );
ok( !(-f $_), "File is no longer present" );
}
}
# Loop over an array hoping that the files dont exist
END { foreach (@files) { ok( !(-e $_), "File $_ should not be present" )} }
# And a test for directories
END { foreach (@dirs) { ok( !(-d $_), "Dir $_ should not be present" )} }
# Need to make sure that the END blocks are setup before
# the ones that File::Temp configures since END blocks are evaluated
# in revers order and we need to check the files *after* File::Temp
# removes them
use File::Temp qw/ tempfile tempdir/;
# Now we start the tests properly
ok(1, "Start test");
# Tempfile
# Open tempfile in some directory, unlink at end
my ($fh, $tempfile) = tempfile(
UNLINK => 1,
SUFFIX => '.txt',
);
ok( (-f $tempfile), "Tempfile exists" );
# Should still be around after closing
ok( close( $fh ), "Tempfile closed" );
ok( (-f $tempfile), "Tempfile exists" );
# Check again at exit
push(@files, $tempfile);
# TEMPDIR test
# Create temp directory in current dir
my $template = 'tmpdirXXXXXX';
print "# Template: $template\n";
my $tempdir = tempdir( $template ,
DIR => File::Spec->curdir,
CLEANUP => 1,
);
print "# TEMPDIR: $tempdir\n";
ok( (-d $tempdir), "Local tempdir exists" );
push(@dirs, File::Spec->rel2abs($tempdir));
my $tempdir2 = tempdir( TEMPLATE => "customXXXXX",
DIR => File::Spec->curdir,
CLEANUP => 1,
);
print "# TEMPDIR2: $tempdir2\n";
like( $tempdir2, qr/custom/, "tempdir with TEMPLATE" );
push(@dirs, File::Spec->rel2abs($tempdir));
# Create file in the temp dir
($fh, $tempfile) = tempfile(
DIR => $tempdir,
UNLINK => 1,
SUFFIX => '.dat',
);
print "# TEMPFILE: Created $tempfile\n";
ok( (-f $tempfile), "Local temp file exists with .dat extension");
push(@files, File::Spec->rel2abs($tempfile));
# Test tempfile
# ..and again
($fh, $tempfile) = tempfile(
DIR => $tempdir,
);
ok( (-f $tempfile ), "Local tempfile in tempdir exists");
push(@files, File::Spec->rel2abs($tempfile));
# Test tempfile
# ..and another with changed permissions (read-only)
($fh, $tempfile) = tempfile(
DIR => $tempdir,
);
chmod 0444, $tempfile;
ok( (-f $tempfile ), "Local tempfile in tempdir exists read-only");
push(@files, File::Spec->rel2abs($tempfile));
print "# TEMPFILE: Created $tempfile\n";
# and another (with template)
($fh, $tempfile) = tempfile( 'helloXXXXXXX',
DIR => $tempdir,
UNLINK => 1,
SUFFIX => '.dat',
);
print "# TEMPFILE: Created $tempfile\n";
ok( (-f $tempfile), "Local tempfile in tempdir with .dat extension exists" );
push(@files, File::Spec->rel2abs($tempfile));
# and another (with TEMPLATE)
($fh, $tempfile) = tempfile( TEMPLATE => 'goodbyeXXXXXXX',
DIR => $tempdir,
UNLINK => 1,
SUFFIX => '.dat',
);
print "# TEMPFILE: Created $tempfile\n";
ok( (-f $tempfile), "Local tempfile in tempdir with TEMPLATE" );
push(@files, File::Spec->rel2abs($tempfile));
# Create a temporary file that should stay around after
# it has been closed
($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
print "# TEMPFILE: Created $tempfile\n";
ok( -f $tempfile, "Long-lived temp file" );
ok( close( $fh ), "Close long-lived temp file" );
push( @still_there, File::Spec->rel2abs($tempfile) ); # check at END
# Would like to create a temp file and just retrieve the handle
# but the test is problematic since:
# - We dont know the filename so we cant check that it is tidied
# correctly
# - The unlink0 required on unix for tempfile creation will fail
# on NFS
# Try to do what we can.
# Tempfile croaks on error so we need an eval
$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
if ($fh) {
# print something to it to make sure something is there
ok( print($fh "Test\n"), "Write to temp file" );
# Close it - can not check it is gone since we dont know the name
ok( close($fh), "Close temp file" );
} else {
skip "Skip Failed probably due to NFS", 1;
skip "Skip Failed probably due to NFS", 1;
}
# Create temp directory and chdir to it; it should still be removed on exit.
$tempdir = tempdir(CLEANUP => 1);
print "# TEMPDIR: $tempdir\n";
ok( (-d $tempdir), "Temp directory in temp dir" );
chdir $tempdir or die $!;
push(@dirs, File::Spec->rel2abs($tempdir));
# Now END block will execute to test the removal of directories
print "# End of tests. Execute END blocks in directory ". cwd() ."\n";
|
