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::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("Skip test failed probably due to \$TMPDIR being on NFS",1); 58} 59 60# MKSTEMPS 61# File with suffix. This is created in the current directory so 62# may be problematic on NFS 63 64$template = "suffixXXXXXX"; 65my $suffix = ".dat"; 66 67($fh, my $fname) = mkstemps($template, $suffix); 68 69print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n"; 70# Check if the file exists 71ok( (-e $fname) ); 72 73# This fails if you are running on NFS 74# If this test fails simply skip it rather than doing a hard failure 75$status = unlink0($fh, $fname); 76 77if ($status) { 78 ok($status); 79} else { 80 skip("Skip test failed probably due to cwd being on NFS",1) 81} 82 83# MKDTEMP 84# Temp directory 85 86$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX'); 87 88my $tmpdir = mkdtemp($template); 89 90print "# MKDTEMP: Name is $tmpdir from template $template\n"; 91 92ok( (-d $tmpdir ) ); 93 94# Need to tidy up after myself 95rmtree($tmpdir); 96 97# MKTEMP 98# Just a filename, not opened 99 100$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX'); 101 102my $tmpfile = mktemp($template); 103 104print "# MKTEMP: Tempfile is $template -> $tmpfile\n"; 105 106# Okay if template no longer has XXXXX in 107 108 109ok( ($tmpfile !~ /XXXXX$/) ); 110