1b39c5158Smillert#!/usr/local/bin/perl -w 2b39c5158Smillert 3b39c5158Smillert# Test for mktemp family of commands in File::Temp 4b39c5158Smillert# Use STANDARD safe level for these tests 5b39c5158Smillert 6b39c5158Smillertuse strict; 791f110e0Safresh1use Test::More tests => 9; 8b39c5158Smillert 9b39c5158Smillertuse File::Spec; 10b39c5158Smillertuse File::Path; 11b39c5158Smillertuse File::Temp qw/ :mktemp unlink0 /; 12b39c5158Smillertuse FileHandle; 13b39c5158Smillert 14b39c5158Smillertok(1); 15b39c5158Smillert 16b39c5158Smillert# MKSTEMP - test 17b39c5158Smillert 18b39c5158Smillert# Create file in temp directory 19*f3efcd01Safresh1my $template = File::Spec->catfile(File::Temp::_wrap_file_spec_tmpdir(), 'wowserXXXX'); 20b39c5158Smillert 21b39c5158Smillert(my $fh, $template) = mkstemp($template); 22b39c5158Smillert 23b39c5158Smillertprint "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n"; 24b39c5158Smillert# Check if the file exists 25b39c5158Smillertok( (-e $template) ); 26b39c5158Smillert 27b39c5158Smillert# Autoflush 28b39c5158Smillert$fh->autoflush(1) if $] >= 5.006; 29b39c5158Smillert 30b39c5158Smillert# Try printing something to the file 31b39c5158Smillertmy $string = "woohoo\n"; 32b39c5158Smillertprint $fh $string; 33b39c5158Smillert 34b39c5158Smillert# rewind the file 35b39c5158Smillertok(seek( $fh, 0, 0)); 36b39c5158Smillert 37b39c5158Smillert# Read from the file 38b39c5158Smillertmy $line = <$fh>; 39b39c5158Smillert 40b39c5158Smillert# compare with previous string 41b39c5158Smillertok($string, $line); 42b39c5158Smillert 43b39c5158Smillert# Tidy up 44b39c5158Smillert# This test fails on Windows NT since it seems that the size returned by 45b39c5158Smillert# stat(filehandle) does not always equal the size of the stat(filename) 46b39c5158Smillert# This must be due to caching. In particular this test writes 7 bytes 47b39c5158Smillert# to the file which are not recognised by stat(filename) 48b39c5158Smillert# Simply waiting 3 seconds seems to be enough for the system to update 49b39c5158Smillert 50b39c5158Smillertif ($^O eq 'MSWin32') { 51b39c5158Smillert sleep 3; 52b39c5158Smillert} 53b39c5158Smillertmy $status = unlink0($fh, $template); 54b39c5158Smillertif ($status) { 55b39c5158Smillert ok( $status ); 56b39c5158Smillert} else { 57*f3efcd01Safresh1 SKIP: { 58b39c5158Smillert skip("Skip test failed probably due to \$TMPDIR being on NFS",1); 59b39c5158Smillert } 60*f3efcd01Safresh1} 61b39c5158Smillert 62b39c5158Smillert# MKSTEMPS 63b39c5158Smillert# File with suffix. This is created in the current directory so 64b39c5158Smillert# may be problematic on NFS 65b39c5158Smillert 66b39c5158Smillert$template = "suffixXXXXXX"; 67b39c5158Smillertmy $suffix = ".dat"; 68b39c5158Smillert 69b39c5158Smillert($fh, my $fname) = mkstemps($template, $suffix); 70b39c5158Smillert 71b39c5158Smillertprint "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n"; 72b39c5158Smillert# Check if the file exists 73b39c5158Smillertok( (-e $fname) ); 74b39c5158Smillert 75b39c5158Smillert# This fails if you are running on NFS 76b39c5158Smillert# If this test fails simply skip it rather than doing a hard failure 77b39c5158Smillert$status = unlink0($fh, $fname); 78b39c5158Smillert 79b39c5158Smillertif ($status) { 80b39c5158Smillert ok($status); 81b39c5158Smillert} else { 82*f3efcd01Safresh1 SKIP: { 83b39c5158Smillert skip("Skip test failed probably due to cwd being on NFS",1) 84b39c5158Smillert } 85*f3efcd01Safresh1} 86b39c5158Smillert 87b39c5158Smillert# MKDTEMP 88b39c5158Smillert# Temp directory 89b39c5158Smillert 90*f3efcd01Safresh1$template = File::Spec->catdir(File::Temp::_wrap_file_spec_tmpdir(), 'tmpdirXXXXXX'); 91b39c5158Smillert 92b39c5158Smillertmy $tmpdir = mkdtemp($template); 93b39c5158Smillert 94b39c5158Smillertprint "# MKDTEMP: Name is $tmpdir from template $template\n"; 95b39c5158Smillert 96b39c5158Smillertok( (-d $tmpdir ) ); 97b39c5158Smillert 98b39c5158Smillert# Need to tidy up after myself 99b39c5158Smillertrmtree($tmpdir); 100b39c5158Smillert 101b39c5158Smillert# MKTEMP 102b39c5158Smillert# Just a filename, not opened 103b39c5158Smillert 104*f3efcd01Safresh1$template = File::Spec->catfile(File::Temp::_wrap_file_spec_tmpdir(), 'mytestXXXXXX'); 105b39c5158Smillert 106b39c5158Smillertmy $tmpfile = mktemp($template); 107b39c5158Smillert 108b39c5158Smillertprint "# MKTEMP: Tempfile is $template -> $tmpfile\n"; 109b39c5158Smillert 110b39c5158Smillert# Okay if template no longer has XXXXX in 111b39c5158Smillert 112b39c5158Smillert 113b39c5158Smillertok( ($tmpfile !~ /XXXXX$/) ); 114