t/lib/ftmp-mktemp.t

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