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