use File::Path qw/ rmtree /;
use Fcntl 1.03;
use Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
+require VMS::Stdio if $^O eq 'VMS';
-# Need the Symbol package if we are running older perl
+# Need the Symbol package if we are running older perl
require Symbol if $] < 5.006;
# Version number
-$VERSION = '0.09';
+$VERSION = '0.10';
# This is a list of characters that can be used in random filenames
my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
-for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
+for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
no strict 'refs';
$OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
}
+# On some systems the O_TEMPORARY flag can be used to tell the OS
+# to automatically remove the file when it is closed. This is fine
+# in most cases but not if tempfile is called with UNLINK=>0 and
+# the filename is requested -- in the case where the filename is to
+# be passed to another routine. This happens on windows. We overcome
+# this by using a second open flags variable
+
+my $OPENTEMPFLAGS = $OPENFLAGS;
+for my $oflag (qw/ TEMPORARY /) {
+ my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+ no strict 'refs';
+ $OPENTEMPFLAGS |= $bit if eval { $bit = &$func(); 1 };
+}
# INTERNAL ROUTINES - not to be used outside of package
# default is 0
# "suffixlen" => number of characters at end of PATH to be ignored.
# default is 0.
+# "unlink_on_close" => indicates that, if possible, the OS should remove
+# the file as soon as it is closed. Usually indicates
+# use of the O_TEMPORARY flag to sysopen.
+# Usually irrelevant on unix
+
# "open" and "mkdir" can not both be true
+# "unlink_on_close" is not used when "mkdir" is true.
# The default options are equivalent to mktemp().
"open" => 0,
"mkdir" => 0,
"suffixlen" => 0,
+ "unlink_on_close" => 0,
);
# Read the template
}
- # Calculate the flags that we wish to use for the sysopen
- # Some of these are not always available
-# my $openflags;
-# if ($options{"open"}) {
- # Default set
-# $openflags = O_CREAT | O_EXCL | O_RDWR;
-
-# for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
-# my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-# no strict 'refs';
-# $openflags |= $bit if eval { $bit = &$func(); 1 };
-# }
-
-# }
-
# Now try MAX_TRIES time to open the file
for (my $i = 0; $i < MAX_TRIES; $i++) {
umask(066);
# Attempt to open the file
- if ( sysopen($fh, $path, $OPENFLAGS, 0600) ) {
+ my $open_success = undef;
+ if ( $^O eq 'VMS' ) { # make it auto delete on close
+ $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+ $open_success = $fh;
+ } else {
+ my $flags = ( $options{"unlink_on_close"} ?
+ $OPENTEMPFLAGS :
+ $OPENFLAGS );
+ $open_success = sysopen($fh, $path, $flags, 0600);
+ }
+ if ( $open_success ) {
# Reset umask
umask($umask);
# - isdir (flag to indicate that we are being given a directory)
# [and hence no filehandle]
-# Status is not referred to since all the magic is done with and END block
+# Status is not referred to since all the magic is done with an END block
{
# Will set up two lexical variables to contain all the files to be
# probably a better way to do this
close($file->[0]); # file handle is [0]
+ # On VMS, the file will be automatically deleted on close,
+ # so we are through with the file already.
+ next if $^O eq 'VMS';
+
if (-f $file->[1]) { # file name is [1]
unlink $file->[1] or warn "Error removing ".$file->[1];
}
if (-d $fname) {
# Directory exists so store it
+ # first on VMS turn []foo into [.foo] for rmtree
+ $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
push (@dirs_to_unlink, $fname);
} else {
- carp "Request to remove directory $fname could not be completed since it does not exists!\n";
+ carp "Request to remove directory $fname could not be completed since it does not exist!\n";
}
} else {
Translates the template as before except that a directory name
is specified.
+ ($fh, $filename) = tempfile($template, UNLINK => 1);
+
+Return the filename and filehandle as before except that the file is
+automatically removed when the program exits. Default is for the file
+to be removed if a file handle is requested and to be kept if the
+filename is requested.
+
If the template is not specified, a template is always
automatically generated. This temporary file is placed in tmpdir()
(L<File::Spec>) unless a directory is specified explicitly with the
and mktemp() functions described elsewhere in this document
if opening the file is not required.
+Options can be combined as required.
+
=cut
sub tempfile {
my ($fh, $path);
croak "Error in tempfile() using $template"
unless (($fh, $path) = _gettemp($template,
- "open" => $options{'OPEN'},
+ "open" => $options{'OPEN'},
"mkdir"=> 0 ,
"suffixlen" => length($options{'SUFFIX'}),
) );
if ($options{'TMPDIR'} || $options{'DIR'}) {
# Strip parent directory from the filename
- #
+ #
# There is no filename at the end
+ $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
# Last directory is then our template
have access to the filehandle).
Additionally, on Windows NT not all the fields returned by stat() can
-be compared. For example, the C<dev> and C<rdev> fields seem to be different
-and also. Also, it seems that the size of the file returned by stat()
+be compared. For example, the C<dev> and C<rdev> fields seem to be
+different. Also, it seems that the size of the file returned by stat()
does not always agree, with C<stat(FH)> being more accurate than
C<stat(filename)>, presumably because of caching issues even when
using autoflush (this is usually overcome by waiting a while after
@okstat = (1,2,3,4,5,7,8,9,10);
} elsif ($^O eq 'os2') {
@okstat = (0, 2..$#fh);
+ } elsif ($^O eq 'VMS') { # device and file ID are sufficient
+ @okstat = (0, 1);
}
# Now compare each entry explicitly by number
-#!/usr/bin/perl -w
+#!/usr/local/bin/perl -w
# Test for File::Temp - tempfile function
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
require Test; import Test;
- plan(tests => 11);
+ plan(tests => 16);
}
use strict;
use File::Spec;
# Will need to check that all files were unlinked correctly
-# Set up an END block here to do it
-
-my (@files, @dirs); # Array containing list of dirs/files to test
+# 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) {
+ ok( -f $_ );
+ ok( unlink( $_ ) );
+ ok( !(-f $_) );
+ }
+}
# Loop over an array hoping that the files dont exist
END { foreach (@files) { ok( !(-e $_) )} }
# And a test for directories
-END { foreach (@dirs) { ok( !(-d $_) )} }
+END { foreach (@dirs) { ok( !(-d $_) )} }
# Need to make sure that the END blocks are setup before
# the ones that File::Temp configures since END blocks are evaluated
ok( (-f $tempfile) );
push(@files, $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 );
+ok( close( $fh ) );
+push( @still_there, $tempfile); # check at END
+
# Now END block will execute to test the removal of directories
projects / p5sagit/p5-mst-13.2.git / commitdiff