lib/File/Temp/mktemp.t

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