xref: /openbsd/gnu/usr.bin/perl/cpan/File-Temp/t/tempfile.t (revision 256a93a4)

#!/usr/local/bin/perl -w
# Test for File::Temp - tempfile function

use strict;
use Test::More tests => 30;
use File::Spec;
use Cwd qw/ cwd /;

# Will need to check that all files were unlinked correctly
# Set up an END block here to do it

# Arrays containing list of dirs/files to test
my (@files, @dirs, @still_there);

# And a test for files that should still be around
# These are tidied up
END {
  foreach (@still_there) {
    ($_) = /(^.*)/; # untaint for testing under taint mode
    ok( -f $_, "File $_ is still present" );
    ok( unlink( $_ ), "Unlink file" );
    ok( !(-f $_), "File is no longer present" );
  }
}

# Loop over an array hoping that the files dont exist
END { foreach (@files) { ok( !(-e $_), "File $_ should not be present" )} }

# And a test for directories
END { foreach (@dirs)  { ok( !(-d $_), "Dir $_ should not be present" )} }

# Need to make sure that the END blocks are setup before
# the ones that File::Temp configures since END blocks are evaluated
# in revers order and we need to check the files *after* File::Temp
# removes them
use File::Temp qw/ tempfile tempdir/;

# Now we start the tests properly
ok(1, "Start test");


# Tempfile
# Open tempfile in some directory, unlink at end
my ($fh, $tempfile) = tempfile(
			       UNLINK => 1,
			       SUFFIX => '.txt',
			      );

ok( (-f $tempfile), "Tempfile exists" );
# Should still be around after closing
ok( close( $fh ), "Tempfile closed" );
ok( (-f $tempfile), "Tempfile exists" );
# Check again at exit
push(@files, $tempfile);

# TEMPDIR test
# Create temp directory in current dir
my $template = 'tmpdirXXXXXX';
print "# Template: $template\n";
my $tempdir = tempdir( $template ,
		       DIR => File::Spec->curdir,
		       CLEANUP => 1,
		     );

print "# TEMPDIR: $tempdir\n";

ok( (-d $tempdir), "Local tempdir exists" );
push(@dirs, File::Spec->rel2abs($tempdir));

my $tempdir2 = tempdir( TEMPLATE => "customXXXXX",
		       DIR => File::Spec->curdir,
		       CLEANUP => 1,
		     );

print "# TEMPDIR2: $tempdir2\n";

like( $tempdir2, qr/custom/, "tempdir with TEMPLATE" );
push(@dirs, File::Spec->rel2abs($tempdir));

# Create file in the temp dir
($fh, $tempfile) = tempfile(
			    DIR => $tempdir,
			    UNLINK => 1,
			    SUFFIX => '.dat',
			   );

print "# TEMPFILE: Created $tempfile\n";

ok( (-f $tempfile), "Local temp file exists with .dat extension");
push(@files, File::Spec->rel2abs($tempfile));

# Test tempfile
# ..and again
($fh, $tempfile) = tempfile(
			    DIR => $tempdir,
			   );


ok( (-f $tempfile ), "Local tempfile in tempdir exists");
push(@files, File::Spec->rel2abs($tempfile));

# Test tempfile
# ..and another with default permissions
($fh, $tempfile) = tempfile(
			    DIR => $tempdir,
			   );

# From perlport on chmod:
#
#     (Win32) Only good for changing "owner" read-write access;
#     "group" and "other" bits are meaningless.
#
# So we don't check the full permissions -- it will be 0444 on Win32
# instead of 0400.  Instead, just check the owner bits.

is((stat($tempfile))[2] & 00700, 0600, 'created tempfile with default permissions');
push(@files, File::Spec->rel2abs($tempfile));

# Test tempfile
# ..and another with changed permissions
($fh, $tempfile) = tempfile(
			    DIR => $tempdir,
			    PERMS => 0400,
			   );

is((stat($tempfile))[2] & 00700, 0400, 'created tempfile with changed permissions');
push(@files, File::Spec->rel2abs($tempfile));

print "# TEMPFILE: Created $tempfile\n";

# and another (with template)

($fh, $tempfile) = tempfile( 'helloXXXXXXX',
			    DIR => $tempdir,
			    UNLINK => 1,
			    SUFFIX => '.dat',
			   );

print "# TEMPFILE: Created $tempfile\n";

ok( (-f $tempfile), "Local tempfile in tempdir with .dat extension exists" );
push(@files, File::Spec->rel2abs($tempfile));


# and another (with TEMPLATE)

($fh, $tempfile) = tempfile( TEMPLATE => 'goodbyeXXXXXXX',
			    DIR => $tempdir,
			    UNLINK => 1,
			    SUFFIX => '.dat',
			   );

print "# TEMPFILE: Created $tempfile\n";

ok( (-f $tempfile), "Local tempfile in tempdir with TEMPLATE" );
push(@files, File::Spec->rel2abs($tempfile));

# Create a temporary file that should stay around after
# it has been closed
($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
print "# TEMPFILE: Created $tempfile\n";
ok( -f $tempfile, "Long-lived temp file" );
ok( close( $fh ), "Close long-lived temp file" );
push( @still_there, File::Spec->rel2abs($tempfile) ); # check at END

# Would like to create a temp file and just retrieve the handle
# but the test is problematic since:
#  - We dont know the filename so we cant check that it is tidied
#    correctly
#  - The unlink0 required on unix for tempfile creation will fail
#    on NFS
# Try to do what we can.
# Tempfile croaks on error so we need an eval
$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Temp::_wrap_file_spec_tmpdir() ) };

if ($fh) {

  # print something to it to make sure something is there
  ok( print($fh "Test\n"), "Write to temp file" );

  # Close it - can not check it is gone since we dont know the name
  ok( close($fh), "Close temp file" );

} else {
    SKIP: {
        skip "Skip Failed probably due to NFS", 2;
    }
}

# Create temp directory and chdir to it; it should still be removed on exit.
$tempdir = tempdir(CLEANUP => 1);

print "# TEMPDIR: $tempdir\n";

ok( (-d $tempdir), "Temp directory in temp dir" );
chdir $tempdir or die $!;
push(@dirs, File::Spec->rel2abs($tempdir));

# Now END block will execute to test the removal of directories
print "# End of tests. Execute END blocks in directory ". cwd() ."\n";