summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2013-03-14 22:34:36 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2013-03-14 23:10:06 +0000
commit940a04b39217e2aa30e922aa13a992903adec835 (patch)
tree6eb9c343803b44527145157de0486442a714a1a7 /cpan
parentd5e7da3f5f24a2f939b1ab09636454644f7dac8a (diff)
downloadperl-940a04b39217e2aa30e922aa13a992903adec835.tar.gz
Update File-Temp to CPAN version 0.23
[DELTA] ---- Release V0.23 CPAN ---- * Build.PL: Use Module::Build * Temp.pm: internally holds absolute path for cleanup (Fixes RT #44924) * t/rmtree.t: (new) Test temp dir removal explicitly. * t/tempfile.t: Correctly tests directory removal from chdir. * Temp.pm: Clean up temp directory on exit even if it is the current directory. Patch supplied by Ed Avis and fixes RT #45246. * Temp.pm: Defer unlinking tempfiles if initial unlink fails instad of croaking; fixes problems on NFS (RT #82720) * Temp.pm: Allow leading template to new() for consistency with newdir() * Temp.pm: Calling tempfile or tempdir as a class method now produce a more useful fatal error message * Temp.pm: new/newdir/tempfile/tempdir now all allow either a leading template argument or a TEMPLATE option * Temp.pm: Overload numify with refaddr() in same manner as IO::File (closes RT #47397 from Kevin Ryde)
Diffstat (limited to 'cpan')
-rw-r--r--cpan/File-Temp/lib/File/Temp.pm107
-rw-r--r--cpan/File-Temp/t/cmp.t48
-rw-r--r--cpan/File-Temp/t/object.t12
-rw-r--r--cpan/File-Temp/t/tempfile.t25
4 files changed, 144 insertions, 48 deletions
diff --git a/cpan/File-Temp/lib/File/Temp.pm b/cpan/File-Temp/lib/File/Temp.pm
index 38113f338c..ac57c260c8 100644
--- a/cpan/File-Temp/lib/File/Temp.pm
+++ b/cpan/File-Temp/lib/File/Temp.pm
@@ -148,6 +148,7 @@ use File::Path qw/ rmtree /;
use Fcntl 1.03;
use IO::Seekable; # For SEEK_*
use Errno;
+use Scalar::Util 'refaddr';
require VMS::Stdio if $^O eq 'VMS';
# pre-emptively load Carp::Heavy. If we don't when we run out of file
@@ -162,7 +163,8 @@ require Symbol if $] < 5.006;
### For the OO interface
use base qw/ IO::Handle IO::Seekable /;
-use overload '""' => "STRINGIFY", fallback => 1;
+use overload '""' => "STRINGIFY", '0+' => "NUMIFY",
+ fallback => 1;
# use 'our' on v5.6.0
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
@@ -205,7 +207,7 @@ Exporter::export_tags('POSIX','mktemp','seekable');
# Version number
-$VERSION = '0.22_90';
+$VERSION = '0.23';
# This is a list of characters that can be used in random filenames
@@ -802,7 +804,7 @@ sub _is_verysafe {
sub _can_unlink_opened_file {
- if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
+ if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
return 0;
} else {
return 1;
@@ -924,8 +926,9 @@ sub _can_do_level {
if (defined $cwd_to_remove) {
# We do need to clean up the current directory, and everything
# else is done, so get out of there and remove it.
- my $root = File::Spec->rootdir;
- chdir $root or die "cannot chdir to $root: $!";
+ chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";
+ my $updir = File::Spec->updir;
+ chdir $updir or die "cannot chdir to $updir: $!";
eval { rmtree($cwd_to_remove, $DEBUG, 0); };
warn $@ if ($@ && $^W);
}
@@ -996,6 +999,24 @@ sub _can_do_level {
}
+# normalize argument keys to upper case and do consistent handling
+# of leading template vs TEMPLATE
+sub _parse_args {
+ my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
+ my %args = @_;
+ %args = map { uc($_), $args{$_} } keys %args;
+
+ # template (store it in an array so that it will
+ # disappear from the arg list of tempfile)
+ my @template = (
+ exists $args{TEMPLATE} ? $args{TEMPLATE} :
+ $leading_template ? $leading_template : ()
+ );
+ delete $args{TEMPLATE};
+
+ return( \@template, \%args );
+}
+
=head1 OBJECT-ORIENTED INTERFACE
This is the primary interface for interacting with
@@ -1004,12 +1025,18 @@ when the object is constructed and the file can be removed when the
object is no longer required.
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, and can be compared to a filename directly. The object
+C<File::Temp> object. The object itself acts as a filehandle. The object
isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
available.
+Also, the object is configured such that it stringifies to the name of the
+temporary file and so can be compared to a filename directly. It numifies
+to the C<refaddr> the same as other handles and so can be compared to other
+handles with C<==>.
+
+ $fh eq $filename # as a string
+ $fh != \*STDOUT # as a number
+
=over 4
=item B<new>
@@ -1042,28 +1069,17 @@ sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
- # read arguments and convert keys to upper case
- my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
- my %args = @_;
- %args = map { uc($_), $args{$_} } keys %args;
+ my ($maybe_template, $args) = _parse_args(@_);
# see if they are unlinking (defaulting to yes)
- my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
- delete $args{UNLINK};
-
- # template (store it in an array so that it will
- # disappear from the arg list of tempfile)
- my @template = (
- exists $args{TEMPLATE} ? $args{TEMPLATE} :
- $leading_template ? $leading_template : ()
- );
- delete $args{TEMPLATE};
+ my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 );
+ delete $args->{UNLINK};
# Protect OPEN
- delete $args{OPEN};
+ delete $args->{OPEN};
# Open the file and retain file handle and file name
- my ($fh, $path) = tempfile( @template, %args );
+ my ($fh, $path) = tempfile( @$maybe_template, %$args );
print "Tmp: $fh - $path\n" if $DEBUG;
@@ -1074,7 +1090,7 @@ sub new {
$FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
# Store unlink information in hash slot (plus other constructor info)
- %{*$fh} = %args;
+ %{*$fh} = %$args;
# create the object
bless $fh, $class;
@@ -1098,25 +1114,21 @@ created with this method default to CLEANUP => 1.
$dir = File::Temp->newdir( $template, %options );
+A template may be specified either with a leading template or
+with a TEMPLATE argument.
+
=cut
sub newdir {
my $self = shift;
- # need to handle args as in tempdir because we have to force CLEANUP
- # default without passing CLEANUP to tempdir
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
- my %options = @_;
- my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
+ my ($maybe_template, $args) = _parse_args(@_);
- delete $options{CLEANUP};
+ # handle CLEANUP without passing CLEANUP to tempdir
+ my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 );
+ delete $args->{CLEANUP};
- my $tempdir;
- if (defined $template) {
- $tempdir = tempdir( $template, %options );
- } else {
- $tempdir = tempdir( %options );
- }
+ my $tempdir = tempdir( @$maybe_template, %$args);
# get a safe absolute path for cleanup, just like
# happens in _deferred_unlink
@@ -1152,6 +1164,13 @@ sub STRINGIFY {
return $self->filename;
}
+# For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because
+# refaddr() demands one parameter only, whereas overload.pm calls with three
+# even for unary operations like '0+'.
+sub NUMIFY {
+ return refaddr($_[0]);
+}
+
=item B<dirname>
Return the name of the temporary directory associated with this
@@ -1356,10 +1375,11 @@ sub tempfile {
);
# Check to see whether we have an odd or even number of arguments
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
+ my ($maybe_template, $args) = _parse_args(@_);
+ my $template = @$maybe_template ? $maybe_template->[0] : undef;
# Read the options and merge with defaults
- %options = (%options, @_) if @_;
+ %options = (%options, %$args);
# First decision is whether or not to open the file
if (! $options{"OPEN"}) {
@@ -1547,10 +1567,11 @@ sub tempdir {
);
# Check to see whether we have an odd or even number of arguments
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+ my ($maybe_template, $args) = _parse_args(@_);
+ my $template = @$maybe_template ? $maybe_template->[0] : undef;
# Read the options and merge with defaults
- %options = (%options, @_) if @_;
+ %options = (%options, %$args);
# Modify or generate the template
@@ -2466,7 +2487,9 @@ package File::Temp::Dir;
use File::Path qw/ rmtree /;
use strict;
-use overload '""' => "STRINGIFY", fallback => 1;
+use overload '""' => "STRINGIFY",
+ '0+' => \&File::Temp::NUMIFY,
+ fallback => 1;
# private class specifically to support tempdir objects
# created by File::Temp->newdir
diff --git a/cpan/File-Temp/t/cmp.t b/cpan/File-Temp/t/cmp.t
index db94e44ccc..d826edec73 100644
--- a/cpan/File-Temp/t/cmp.t
+++ b/cpan/File-Temp/t/cmp.t
@@ -1,11 +1,51 @@
#!perl -w
# Test overloading
-use Test::More tests => 3;
+use Test::More tests => 19;
use strict;
BEGIN {use_ok( "File::Temp" ); }
-my $fh = new File::Temp();
-ok( "$fh" ne "foo", "compare stringified object with string");
-ok( $fh ne "foo", "compare object with string"); \ No newline at end of file
+{
+ my $fh = new File::Temp();
+ isa_ok ($fh, 'File::Temp');
+
+ ok( "$fh" ne "foo", "compare stringified object with string");
+ ok( $fh ne "foo", "compare object with string");
+ ok( $fh eq $fh, "compare eq with self");
+
+ ok( $fh != 0, "compare != 0");
+ ok( $fh == $fh, "compare == with self");
+ ok( $fh != \*STDOUT, "compare != \*STDOUT");
+
+ {
+ my $num = $fh+0;
+ like ($num, qr/^\d+$/, '+0 is a number');
+ }
+ {
+ my $str = "$fh";
+ unlike ($str, qr/^\d+$/, '"" is not a number');
+ }
+}
+
+{
+ my $fh = File::Temp->newdir();
+ isa_ok ($fh, 'File::Temp::Dir');
+
+ ok( "$fh" ne "foo", "compare stringified object with string");
+ ok( $fh ne "foo", "compare object with string");
+ ok( $fh eq $fh, "compare eq with self");
+
+ ok( $fh != 0, "compare != 0");
+ ok( $fh == $fh, "compare == with self");
+ ok( $fh != \*STDOUT, "compare != \*STDOUT");
+
+ {
+ my $num = $fh+0;
+ like ($num, qr/^\d+$/, '+0 is a number');
+ }
+ {
+ my $str = "$fh";
+ unlike ($str, qr/^\d+$/, '"" is not a number');
+ }
+}
diff --git a/cpan/File-Temp/t/object.t b/cpan/File-Temp/t/object.t
index 267ccd2806..5732bfd0c2 100644
--- a/cpan/File-Temp/t/object.t
+++ b/cpan/File-Temp/t/object.t
@@ -2,7 +2,7 @@
# Test for File::Temp - OO interface
use strict;
-use Test::More tests => 33;
+use Test::More tests => 35;
use File::Spec;
# Will need to check that all files were unlinked correctly
@@ -57,6 +57,15 @@ ok( -d $dirname, "Directory $tdir exists");
undef $tdir;
ok( !-d $dirname, "Directory should now be gone");
+# with template
+$tdir = File::Temp->newdir( TEMPLATE => 'helloXXXXX' );
+like( "$tdir", qr/hello/, "Directory with TEMPLATE" );
+undef $tdir;
+
+$tdir = File::Temp->newdir( 'helloXXXXX' );
+like( "$tdir", qr/hello/, "Directory with leading template" );
+undef $tdir;
+
# Quick basic tempfile test
my $qfh = File::Temp->new();
my $qfname = "$qfh";
@@ -121,6 +130,7 @@ like( "$fh", qr/hello/, "saw template" );
push(@files, "$fh");
+
# Create a temporary file that should stay around after
# it has been closed
$fh = new File::Temp( TEMPLATE => 'permXXXXXXX', UNLINK => 0);
diff --git a/cpan/File-Temp/t/tempfile.t b/cpan/File-Temp/t/tempfile.t
index 7698806348..555c53ad69 100644
--- a/cpan/File-Temp/t/tempfile.t
+++ b/cpan/File-Temp/t/tempfile.t
@@ -2,7 +2,7 @@
# Test for File::Temp - tempfile function
use strict;
-use Test::More tests => 24;
+use Test::More tests => 28;
use File::Spec;
use Cwd qw/ cwd /;
@@ -67,6 +67,16 @@ 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,
@@ -115,6 +125,19 @@ 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 );