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