t/lib/ftmp-tempfile.t

   1 #!/usr/local/bin/perl -w
   2 # Test for File::Temp - tempfile function
   3
   4 BEGIN {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Test; import Test;
   8         plan(tests => 20);
   9 }
  10
  11 use strict;
  12 use File::Spec;
  13
  14 # Will need to check that all files were unlinked correctly
  15 # Set up an END block here to do it
  16
  17 # Arrays containing list of dirs/files to test
  18 my (@files, @dirs, @still_there);
  19
  20 # And a test for files that should still be around
  21 # These are tidied up
  22 END {
  23   foreach (@still_there) {
  24     ok( -f $_ );
  25     ok( unlink( $_ ) );
  26     ok( !(-f $_) );
  27   }
  28 }
  29
  30 # Loop over an array hoping that the files dont exist
  31 END { foreach (@files) { ok( !(-e $_) )} }
  32
  33 # And a test for directories
  34 END { foreach (@dirs)  { ok( !(-d $_) )} }
  35
  36 # Need to make sure that the END blocks are setup before
  37 # the ones that File::Temp configures since END blocks are evaluated
  38 # in revers order and we need to check the files *after* File::Temp
  39 # removes them
  40 use File::Temp qw/ tempfile tempdir/;
  41
  42 # Now we start the tests properly
  43 ok(1);
  44
  45
  46 # Tempfile
  47 # Open tempfile in some directory, unlink at end
  48 my ($fh, $tempfile) = tempfile(
  49                                UNLINK => 1,
  50                                SUFFIX => '.txt',
  51                               );
  52
  53 ok( (-f $tempfile) );
  54 # Should still be around after closing
  55 ok( close( $fh ) );
  56 ok( (-f $tempfile) );
  57 # Check again at exit
  58 push(@files, $tempfile);
  59
  60 # TEMPDIR test
  61 # Create temp directory in current dir
  62 my $template = 'tmpdirXXXXXX';
  63 print "# Template: $template\n";
  64 my $tempdir = tempdir( $template ,
  65                        DIR => File::Spec->curdir,
  66                        CLEANUP => 1,
  67                      );
  68
  69 print "# TEMPDIR: $tempdir\n";
  70
  71 ok( (-d $tempdir) );
  72 push(@dirs, $tempdir);
  73
  74 # Create file in the temp dir
  75 ($fh, $tempfile) = tempfile(
  76                             DIR => $tempdir,
  77                             UNLINK => 1,
  78                             SUFFIX => '.dat',
  79                            );
  80
  81 print "# TEMPFILE: Created $tempfile\n";
  82
  83 ok( (-f $tempfile));
  84 push(@files, $tempfile);
  85
  86 # Test tempfile
  87 # ..and again
  88 ($fh, $tempfile) = tempfile(
  89                             DIR => $tempdir,
  90                            );
  91
  92
  93 ok( (-f $tempfile ));
  94 push(@files, $tempfile);
  95
  96 print "# TEMPFILE: Created $tempfile\n";
  97
  98 # and another (with template)
  99
 100 ($fh, $tempfile) = tempfile( 'helloXXXXXXX',
 101                             DIR => $tempdir,
 102                             UNLINK => 1,
 103                             SUFFIX => '.dat',
 104                            );
 105
 106 print "# TEMPFILE: Created $tempfile\n";
 107
 108 ok( (-f $tempfile) );
 109 push(@files, $tempfile);
 110
 111
 112 # Create a temporary file that should stay around after
 113 # it has been closed
 114 ($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
 115 print "# TEMPFILE: Created $tempfile\n";
 116 ok( -f $tempfile );
 117 ok( close( $fh ) );
 118 push( @still_there, $tempfile); # check at END
 119
 120 # Would like to create a temp file and just retrieve the handle
 121 # but the test is problematic since:
 122 #  - We dont know the filename so we cant check that it is tidied
 123 #    correctly
 124 #  - The unlink0 required on unix for tempfile creation will fail
 125 #    on NFS
 126 # Try to do what we can.
 127 # Tempfile croaks on error so we need an eval
 128 $fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
 129
 130 if ($fh) {
 131
 132   # print something to it to make sure something is there
 133   ok( print $fh "Test\n" );
 134
 135   # Close it - can not check it is gone since we dont know the name
 136   ok( close($fh) );
 137
 138 } else {
 139   skip "Skip Failed probably due to NFS", 1;
 140   skip "Skip Failed probably due to NFS", 1;
 141 }
 142
 143 # Now END block will execute to test the removal of directories
 144 print "# End of tests. Execute END blocks\n";
 145