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