require File::Temp;
use File::Temp ();
+ use File::Temp qw/ :seekable /;
- $fh = new File::Temp($template);
+ $fh = new File::Temp();
+ $fname = $fh->filename;
+
+ $fh = new File::Temp(TEMPLATE => $template);
$fname = $fh->filename;
$tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
print $tmp "Some data\n";
print "Filename is $tmp\n";
+ $tmp->seek( 0, SEEK_END );
The following interfaces are provided for compatibility with
existing APIs. They should not be used in new code.
=cut
# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
-# People would like a version on 5.005 so give them what they want :-)
-use 5.005;
+# People would like a version on 5.004 so give them what they want :-)
+use 5.004;
use strict;
use Carp;
use File::Spec 0.8;
use File::Path qw/ rmtree /;
use Fcntl 1.03;
+use IO::Seekable; # For SEEK_*
use Errno;
require VMS::Stdio if $^O eq 'VMS';
+# pre-emptively load Carp::Heavy. If we don't when we run out of file
+# handles and attempt to call croak() we get an error message telling
+# us that Carp::Heavy won't load rather than an error telling us we
+# have run out of file handles. We either preload croak() or we
+# switch the calls to croak from _gettemp() to use die.
+require Carp::Heavy;
+
# Need the Symbol package if we are running older perl
require Symbol if $] < 5.006;
### For the OO interface
-use base qw/ IO::Handle /;
-use overload '""' => "STRINGIFY";
-
+use base qw/ IO::Handle IO::Seekable /;
+use overload '""' => "STRINGIFY", fallback => 1;
# use 'our' on v5.6.0
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
mkdtemp
unlink0
cleanup
+ SEEK_SET
+ SEEK_CUR
+ SEEK_END
};
# Groups of functions for export
%EXPORT_TAGS = (
'POSIX' => [qw/ tmpnam tmpfile /],
'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+ 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
);
# add contents of these tags to @EXPORT
-Exporter::export_tags('POSIX','mktemp');
+Exporter::export_tags('POSIX','mktemp','seekable');
# Version number
-$VERSION = '0.16';
+$VERSION = '0.18';
# This is a list of characters that can be used in random filenames
no strict 'refs';
$OPENFLAGS |= $bit if eval {
# Make sure that redefined die handlers do not cause problems
- # eg CGI::Carp
+ # e.g. CGI::Carp
local $SIG{__DIE__} = sub {};
local $SIG{__WARN__} = sub {};
$bit = &$func();
no strict 'refs';
$OPENTEMPFLAGS |= $bit if eval {
# Make sure that redefined die handlers do not cause problems
- # eg CGI::Carp
+ # e.g. CGI::Carp
local $SIG{__DIE__} = sub {};
local $SIG{__WARN__} = sub {};
$bit = &$func();
# Substr starts from 0
my $start = length($template) - 1 - $options{"suffixlen"};
- # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
+ # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
# (taking suffixlen into account). Any fewer is insecure.
# Do it using substr - no reason to use a pattern match since
# but may have O_NOINHERIT. This may or may not be in Fcntl.
local $^F = 2;
- # Store callers umask
- my $umask = umask();
-
- # Set a known umask
- umask(066);
-
# Attempt to open the file
my $open_success = undef;
if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
}
if ( $open_success ) {
- # Reset umask
- umask($umask) if defined $umask;
+ # in case of odd umask force rw
+ chmod(0600, $path);
# Opened successfully - return file handle and name
return ($fh, $path);
} else {
- # Reset umask
- umask($umask) if defined $umask;
# Error opening file - abort with error
# if the reason was anything but EEXIST
}
} elsif ($options{"mkdir"}) {
- # Store callers umask
- my $umask = umask();
-
- # Set a known umask
- umask(066);
-
# Open the temp directory
if (mkdir( $path, 0700)) {
- # created okay
- # Reset umask
- umask($umask) if defined $umask;
+ # in case of odd umask
+ chmod(0700, $path);
return undef, $path;
} else {
- # Reset umask
- umask($umask) if defined $umask;
-
# Abort with error if the reason for failure was anything
# except EEXIST
unless ($!{EEXIST}) {
# force a file to be readonly when written to certain temp locations
sub _force_writable {
my $file = shift;
- my $umask = umask();
- umask(066);
chmod 0600, $file;
- umask($umask) if defined $umask;
}
return 1 if $^O eq 'VMS'; # owner delete control at file level
# Check to see whether owner is neither superuser (or a system uid) nor me
- # Use the real uid from the $< variable
+ # Use the effective uid from the $> variable
# UID is in [4]
- if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+ if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
- Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
File::Temp->top_system_uid());
$$err_ref = "Directory owned neither by root nor the current user"
Note that there is no method to obtain the filehandle from the
C<File::Temp> object. The object itself acts as a filehandle. Also,
the object is configured such that it stringifies to the name of the
-temporary file.
+temporary file, and can be compared to a filename directly. The object
+isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
+available.
=over 4
Arguments are case insensitive.
+Can call croak() if an error occurs.
+
=cut
sub new {
Options can be combined as required.
+Will croak() if there is an error.
+
=cut
sub tempfile {
Of course, if the template is not specified, the temporary directory
will be created in tmpdir() and will also be removed at program exit.
+Will croak() if there is an error.
+
=cut
# '
to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
with unique alphanumeric combinations.
+Will croak() if there is an error.
+
=cut
Returns just the filehandle alone when called in scalar context.
+Will croak() if there is an error.
+
=cut
sub mkstemps {
$tmpdir_name = mkdtemp($template);
Returns the name of the temporary directory created.
-Returns undef on failure.
Directory must be removed by the caller.
+Will croak() if there is an error.
+
=cut
#' # for emacs
Template is the same as that required by mkstemp().
+Will croak() if there is an error.
+
=cut
sub mktemp {
See L<File::Spec/tmpdir> for information on the choice of temporary
directory for a particular operating system.
+Will croak() if there is an error.
+
=cut
sub tmpnam {
Currently this command will probably not work when the temporary
directory is on an NFS file system.
+Will croak() if there is an error.
+
=cut
sub tmpfile {
Because this function uses mktemp(), it can suffer from race conditions.
+Will croak() if there is an error.
+
=cut
sub tempnam {
unlink0($fh, $path)
or die "Error unlinking file $path safely";
-Returns false on error. The filehandle is not closed since on some
-occasions this is not required.
+Returns false on error but croaks() if there is a security
+anomaly. The filehandle is not closed since on some occasions this is
+not required.
On some platforms, for example Windows NT, it is not possible to
unlink an open file (the file must be closed first). On those
and an unlink on open file is supported. If the unlink is to be deferred
to the END block, the file is still registered for removal.
+This function should not be called if you are using the object oriented
+interface since the it will interfere with the object destructor deleting
+the file.
+
=cut
sub unlink0 {
or die "Error comparing handle with file";
Returns false if the stat information differs or if the link count is
-greater than 1.
+greater than 1. Calls croak if there is a security anomaly.
-On certain platforms, e.g. Windows, not all the fields returned by stat()
+On certain platforms, for example Windows, not all the fields returned by stat()
can be compared. For example, the C<dev> and C<rdev> fields seem to be
different in Windows. Also, it seems that the size of the file
returned by stat() does not always agree, with C<stat(FH)> being more
This function is disabled if the global variable $KEEP_ALL is true.
+Can call croak() if there is a security anomaly during the stat()
+comparison.
+
=cut
sub unlink1 {
means that a child will not attempt to remove temp files created by the
parent process.
+If you are forking many processes in parallel that are all creating
+temporary files, you may need to reset the random number seed using
+srand(EXPR) in each child else all the children will attempt to walk
+through the same set of random file names and may well cause
+themselves to give up if they exceed the number of retry attempts.
+
=head2 BINMODE
The file returned by File::Temp will have been opened in binary mode
L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
-See L<IO::File> and L<File::MkTemp>, L<Apachae::TempFile> for
+See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
different implementations of temporary file handling.
=head1 AUTHOR
Tim Jenness E<lt>tjenness@cpan.orgE<gt>
-Copyright (C) 1999-2005 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
Astronomy Research Council. All Rights Reserved. This program is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.
projects / p5sagit/p5-mst-13.2.git / blobdiff