1#!/usr/local/bin/perl -w
2# Test for File::Temp - tempfile function
3
4use strict;
5use Test::More tests => 30;
6use File::Spec;
7use Cwd qw/ cwd /;
8
9# Will need to check that all files were unlinked correctly
10# Set up an END block here to do it
11
12# Arrays containing list of dirs/files to test
13my (@files, @dirs, @still_there);
14
15# And a test for files that should still be around
16# These are tidied up
17END {
18  foreach (@still_there) {
19    ($_) = /(^.*)/; # untaint for testing under taint mode
20    ok( -f $_, "File $_ is still present" );
21    ok( unlink( $_ ), "Unlink file" );
22    ok( !(-f $_), "File is no longer present" );
23  }
24}
25
26# Loop over an array hoping that the files dont exist
27END { foreach (@files) { ok( !(-e $_), "File $_ should not be present" )} }
28
29# And a test for directories
30END { foreach (@dirs)  { ok( !(-d $_), "Dir $_ should not be present" )} }
31
32# Need to make sure that the END blocks are setup before
33# the ones that File::Temp configures since END blocks are evaluated
34# in revers order and we need to check the files *after* File::Temp
35# removes them
36use File::Temp qw/ tempfile tempdir/;
37
38# Now we start the tests properly
39ok(1, "Start test");
40
41
42# Tempfile
43# Open tempfile in some directory, unlink at end
44my ($fh, $tempfile) = tempfile(
45			       UNLINK => 1,
46			       SUFFIX => '.txt',
47			      );
48
49ok( (-f $tempfile), "Tempfile exists" );
50# Should still be around after closing
51ok( close( $fh ), "Tempfile closed" );
52ok( (-f $tempfile), "Tempfile exists" );
53# Check again at exit
54push(@files, $tempfile);
55
56# TEMPDIR test
57# Create temp directory in current dir
58my $template = 'tmpdirXXXXXX';
59print "# Template: $template\n";
60my $tempdir = tempdir( $template ,
61		       DIR => File::Spec->curdir,
62		       CLEANUP => 1,
63		     );
64
65print "# TEMPDIR: $tempdir\n";
66
67ok( (-d $tempdir), "Local tempdir exists" );
68push(@dirs, File::Spec->rel2abs($tempdir));
69
70my $tempdir2 = tempdir( TEMPLATE => "customXXXXX",
71		       DIR => File::Spec->curdir,
72		       CLEANUP => 1,
73		     );
74
75print "# TEMPDIR2: $tempdir2\n";
76
77like( $tempdir2, qr/custom/, "tempdir with TEMPLATE" );
78push(@dirs, File::Spec->rel2abs($tempdir));
79
80# Create file in the temp dir
81($fh, $tempfile) = tempfile(
82			    DIR => $tempdir,
83			    UNLINK => 1,
84			    SUFFIX => '.dat',
85			   );
86
87print "# TEMPFILE: Created $tempfile\n";
88
89ok( (-f $tempfile), "Local temp file exists with .dat extension");
90push(@files, File::Spec->rel2abs($tempfile));
91
92# Test tempfile
93# ..and again
94($fh, $tempfile) = tempfile(
95			    DIR => $tempdir,
96			   );
97
98
99ok( (-f $tempfile ), "Local tempfile in tempdir exists");
100push(@files, File::Spec->rel2abs($tempfile));
101
102# Test tempfile
103# ..and another with default permissions
104($fh, $tempfile) = tempfile(
105			    DIR => $tempdir,
106			   );
107
108# From perlport on chmod:
109#
110#     (Win32) Only good for changing "owner" read-write access;
111#     "group" and "other" bits are meaningless.
112#
113# So we don't check the full permissions -- it will be 0444 on Win32
114# instead of 0400.  Instead, just check the owner bits.
115
116is((stat($tempfile))[2] & 00700, 0600, 'created tempfile with default permissions');
117push(@files, File::Spec->rel2abs($tempfile));
118
119# Test tempfile
120# ..and another with changed permissions
121($fh, $tempfile) = tempfile(
122			    DIR => $tempdir,
123			    PERMS => 0400,
124			   );
125
126is((stat($tempfile))[2] & 00700, 0400, 'created tempfile with changed permissions');
127push(@files, File::Spec->rel2abs($tempfile));
128
129print "# TEMPFILE: Created $tempfile\n";
130
131# and another (with template)
132
133($fh, $tempfile) = tempfile( 'helloXXXXXXX',
134			    DIR => $tempdir,
135			    UNLINK => 1,
136			    SUFFIX => '.dat',
137			   );
138
139print "# TEMPFILE: Created $tempfile\n";
140
141ok( (-f $tempfile), "Local tempfile in tempdir with .dat extension exists" );
142push(@files, File::Spec->rel2abs($tempfile));
143
144
145# and another (with TEMPLATE)
146
147($fh, $tempfile) = tempfile( TEMPLATE => 'goodbyeXXXXXXX',
148			    DIR => $tempdir,
149			    UNLINK => 1,
150			    SUFFIX => '.dat',
151			   );
152
153print "# TEMPFILE: Created $tempfile\n";
154
155ok( (-f $tempfile), "Local tempfile in tempdir with TEMPLATE" );
156push(@files, File::Spec->rel2abs($tempfile));
157
158# Create a temporary file that should stay around after
159# it has been closed
160($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
161print "# TEMPFILE: Created $tempfile\n";
162ok( -f $tempfile, "Long-lived temp file" );
163ok( close( $fh ), "Close long-lived temp file" );
164push( @still_there, File::Spec->rel2abs($tempfile) ); # check at END
165
166# Would like to create a temp file and just retrieve the handle
167# but the test is problematic since:
168#  - We dont know the filename so we cant check that it is tidied
169#    correctly
170#  - The unlink0 required on unix for tempfile creation will fail
171#    on NFS
172# Try to do what we can.
173# Tempfile croaks on error so we need an eval
174$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Temp::_wrap_file_spec_tmpdir() ) };
175
176if ($fh) {
177
178  # print something to it to make sure something is there
179  ok( print($fh "Test\n"), "Write to temp file" );
180
181  # Close it - can not check it is gone since we dont know the name
182  ok( close($fh), "Close temp file" );
183
184} else {
185    SKIP: {
186        skip "Skip Failed probably due to NFS", 2;
187    }
188}
189
190# Create temp directory and chdir to it; it should still be removed on exit.
191$tempdir = tempdir(CLEANUP => 1);
192
193print "# TEMPDIR: $tempdir\n";
194
195ok( (-d $tempdir), "Temp directory in temp dir" );
196chdir $tempdir or die $!;
197push(@dirs, File::Spec->rel2abs($tempdir));
198
199# Now END block will execute to test the removal of directories
200print "# End of tests. Execute END blocks in directory ". cwd() ."\n";
201
202