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