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
|
#!/usr/local/bin/perl -w
# Test for File::Temp - tempfile function
use strict;
use Test;
BEGIN { plan tests => 22}
use File::Spec;
# 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) {
ok( -f $_ );
ok( unlink( $_ ) );
ok( !(-f $_) );
}
}
# Loop over an array hoping that the files dont exist
END { foreach (@files) { ok( !(-e $_) )} }
# And a test for directories
END { foreach (@dirs) { ok( !(-d $_) )} }
# 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);
# Tempfile
# Open tempfile in some directory, unlink at end
my ($fh, $tempfile) = tempfile(
UNLINK => 1,
SUFFIX => '.txt',
);
ok( (-f $tempfile) );
# Should still be around after closing
ok( close( $fh ) );
ok( (-f $tempfile) );
# 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) );
push(@dirs, $tempdir);
# Create file in the temp dir
($fh, $tempfile) = tempfile(
DIR => $tempdir,
UNLINK => 1,
SUFFIX => '.dat',
);
print "# TEMPFILE: Created $tempfile\n";
ok( (-f $tempfile));
push(@files, $tempfile);
# Test tempfile
# ..and again
($fh, $tempfile) = tempfile(
DIR => $tempdir,
);
ok( (-f $tempfile ));
push(@files, $tempfile);
# Test tempfile
# ..and another with changed permissions (read-only)
($fh, $tempfile) = tempfile(
DIR => $tempdir,
);
chmod 0444, $tempfile;
ok( (-f $tempfile ));
push(@files, $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) );
push(@files, $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 );
ok( close( $fh ) );
push( @still_there, $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" );
# Close it - can not check it is gone since we dont know the name
ok( close($fh) );
} else {
skip "Skip Failed probably due to NFS", 1;
skip "Skip Failed probably due to NFS", 1;
}
# Now END block will execute to test the removal of directories
print "# End of tests. Execute END blocks\n";
|
