t/lib/ftmp-mktemp.t

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