This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update File-Temp to CPAN version 0.2310
authorKaren Etheridge <ether@cpan.org>
Sat, 26 Sep 2020 17:38:50 +0000 (10:38 -0700)
committerKaren Etheridge <ether@cpan.org>
Sat, 26 Sep 2020 17:40:26 +0000 (10:40 -0700)
  [DELTA]

0.2310    2020-09-26 17:37:56Z
          - add AppVeyor CI
          - Add PERMS options to create temp file with given file permissions
          - remove remaining uses of indirect object syntax (#34, Nicolas R)

Porting/Maintainers.pl
cpan/File-Temp/lib/File/Temp.pm
cpan/File-Temp/t/cmp.t
cpan/File-Temp/t/fork.t
cpan/File-Temp/t/lock.t
cpan/File-Temp/t/object.t
cpan/File-Temp/t/rmtree.t
cpan/File-Temp/t/tempfile.t

index 7d7e4ac..da5a9fc 100755 (executable)
@@ -535,7 +535,7 @@ use File::Glob qw(:case);
     },
 
     'File::Temp' => {
-        'DISTRIBUTION' => 'ETHER/File-Temp-0.2309.tar.gz',
+        'DISTRIBUTION' => 'ETHER/File-Temp-0.2310.tar.gz',
         'FILES'        => q[cpan/File-Temp],
         'EXCLUDED'     => [
             qw( README.mkdn
index 39e15d5..99c8aeb 100644 (file)
@@ -1,7 +1,7 @@
-package File::Temp; # git description: v0.2308-7-g3bb4d88
+package File::Temp; # git description: v0.2309-16-g1d3137c
 # ABSTRACT: return name and handle of a temporary file safely
 
-our $VERSION = '0.2309';
+our $VERSION = '0.2310';
 
 #pod =begin :__INTERNALS
 #pod
@@ -307,6 +307,7 @@ my %FILES_CREATED_BY_OBJECT;
 #                        use of the O_TEMPORARY flag to sysopen.
 #                        Usually irrelevant on unix
 #   "use_exlock" => Indicates that O_EXLOCK should be used. Default is false.
+#   "file_permissions" => file permissions for sysopen(). Default is 0600.
 
 # Optionally a reference to a scalar can be passed into the function
 # On error this will be used to store the reason for the error
@@ -339,12 +340,13 @@ sub _gettemp {
 
   # Default options
   my %options = (
-                 "open" => 0,
-                 "mkdir" => 0,
-                 "suffixlen" => 0,
-                 "unlink_on_close" => 0,
-                 "use_exlock" => 0,
-                 "ErrStr" => \$tempErrStr,
+                 "open"             => 0,
+                 "mkdir"            => 0,
+                 "suffixlen"        => 0,
+                 "unlink_on_close"  => 0,
+                 "use_exlock"       => 0,
+                 "ErrStr"           => \$tempErrStr,
+                 "file_permissions" => undef,
                 );
 
   # Read the template
@@ -480,6 +482,9 @@ sub _gettemp {
     }
   }
 
+  my $perms = $options{file_permissions};
+  my $has_perms = defined $perms;
+  $perms = 0600 unless $has_perms;
 
   # Now try MAX_TRIES time to open the file
   for (my $i = 0; $i < MAX_TRIES; $i++) {
@@ -502,19 +507,19 @@ sub _gettemp {
       my $open_success = undef;
       if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
         # make it auto delete on close by setting FAB$V_DLT bit
-        $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+        $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, $perms, 'fop=dlt');
         $open_success = $fh;
       } else {
         my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
                       $OPENTEMPFLAGS :
                       $OPENFLAGS );
         $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
-        $open_success = sysopen($fh, $path, $flags, 0600);
+        $open_success = sysopen($fh, $path, $flags, $perms);
       }
       if ( $open_success ) {
 
         # in case of odd umask force rw
-        chmod(0600, $path);
+        chmod($perms, $path) unless $has_perms;
 
         # Opened successfully - return file handle and name
         return ($fh, $path);
@@ -799,7 +804,7 @@ sub _is_verysafe {
 
 sub _can_unlink_opened_file {
 
-  if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
+  if (grep $^O eq $_, qw/MSWin32 os2 VMS dos MacOS haiku/) {
     return 0;
   } else {
     return 1;
@@ -999,7 +1004,7 @@ sub _can_do_level {
 sub _parse_args {
   my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
   my %args = @_;
-  %args = map { uc($_), $args{$_} } keys %args;
+  %args = map +(uc($_) => $args{$_}), keys %args;
 
   # template (store it in an array so that it will
   # disappear from the arg list of tempfile)
@@ -1048,7 +1053,8 @@ sub _parse_args {
 #pod if UNLINK is set to true (the default).
 #pod
 #pod Supported arguments are the same as for C<tempfile>: UNLINK
-#pod (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
+#pod (defaulting to true), DIR, EXLOCK, PERMS and SUFFIX.
+#pod Additionally, the filename
 #pod template is specified using the TEMPLATE option. The OPEN option
 #pod is not supported (the file is always opened).
 #pod
@@ -1359,6 +1365,11 @@ sub DESTROY {
 #pod
 #pod   ($fh, $filename) = tempfile($template, EXLOCK => 1);
 #pod
+#pod By default, the temp file is created with 0600 file permissions.
+#pod Use C<PERMS> to change this:
+#pod
+#pod   ($fh, $filename) = tempfile($template, PERMS => 0666);
+#pod
 #pod Options can be combined as required.
 #pod
 #pod Will croak() if there is an error.
@@ -1371,6 +1382,8 @@ sub DESTROY {
 #pod
 #pod EXLOCK flag available since 0.19.
 #pod
+#pod PERMS flag available since 0.24.
+#pod
 #pod =cut
 
 sub tempfile {
@@ -1386,8 +1399,9 @@ sub tempfile {
                  "SUFFIX" => '',    # Template suffix
                  "UNLINK" => 0,     # Do not unlink file on exit
                  "OPEN"   => 1,     # Open file
-                 "TMPDIR" => 0, # Place tempfile in tempdir if template specified
-                 "EXLOCK" => 0, # Open file with O_EXLOCK
+                 "TMPDIR" => 0,     # Place tempfile in tempdir if template specified
+                 "EXLOCK" => 0,     # Open file with O_EXLOCK
+                 "PERMS"  => undef, # File permissions
                 );
 
   # Check to see whether we have an odd or even number of arguments
@@ -1464,12 +1478,13 @@ sub tempfile {
   my ($fh, $path, $errstr);
   croak "Error in tempfile() using template $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
-                                    "open" => $options{'OPEN'},
-                                    "mkdir"=> 0 ,
-                                    "unlink_on_close" => $unlink_on_close,
-                                    "suffixlen" => length($options{'SUFFIX'}),
-                                    "ErrStr" => \$errstr,
-                                    "use_exlock" => $options{EXLOCK},
+                                    "open"             => $options{OPEN},
+                                    "mkdir"            => 0,
+                                    "unlink_on_close"  => $unlink_on_close,
+                                    "suffixlen"        => length($options{SUFFIX}),
+                                    "ErrStr"           => \$errstr,
+                                    "use_exlock"       => $options{EXLOCK},
+                                    "file_permissions" => $options{PERMS},
                                    ) );
 
   # Set up an exit handler that can do whatever is right for the
@@ -2581,7 +2596,7 @@ sub unlink1 {
 package ## hide from PAUSE
   File::Temp::Dir;
 
-our $VERSION = '0.2309';
+our $VERSION = '0.2310';
 
 use File::Path qw/ rmtree /;
 use strict;
@@ -2648,7 +2663,7 @@ File::Temp - return name and handle of a temporary file safely
 
 =head1 VERSION
 
-version 0.2309
+version 0.2310
 
 =head1 SYNOPSIS
 
@@ -2819,7 +2834,8 @@ that the temporary file is removed by the object destructor
 if UNLINK is set to true (the default).
 
 Supported arguments are the same as for C<tempfile>: UNLINK
-(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
+(defaulting to true), DIR, EXLOCK, PERMS and SUFFIX.
+Additionally, the filename
 template is specified using the TEMPLATE option. The OPEN option
 is not supported (the file is always opened).
 
@@ -3004,6 +3020,11 @@ versions, explicitly set C<< EXLOCK=>0 >>.
 
   ($fh, $filename) = tempfile($template, EXLOCK => 1);
 
+By default, the temp file is created with 0600 file permissions.
+Use C<PERMS> to change this:
+
+  ($fh, $filename) = tempfile($template, PERMS => 0666);
+
 Options can be combined as required.
 
 Will croak() if there is an error.
@@ -3016,6 +3037,8 @@ TMPDIR flag available since 0.19.
 
 EXLOCK flag available since 0.19.
 
+PERMS flag available since 0.24.
+
 =item B<tempdir>
 
 This is the recommended interface for creation of temporary
@@ -3606,13 +3629,13 @@ Tim Jenness <tjenness@cpan.org>
 
 =head1 CONTRIBUTORS
 
-=for stopwords David Golden Karen Etheridge Slaven Rezic Peter Rabbitson Olivier Mengue Kevin Ryde John Acklam James E. Keenan Brian Mowrey Dagfinn Ilmari Mannsåker Steinbrunner Ed Avis Guillem Jover Ben Tilly
+=for stopwords Tim Jenness Karen Etheridge David Golden Slaven Rezic mohawk2 Roy Ivy III Peter Rabbitson Olivier Mengué John Acklam Gim Yee Nicolas R Brian Mowrey Dagfinn Ilmari Mannsåker Steinbrunner Ed Avis Guillem Jover James E. Keenan Kevin Ryde Ben Tilly
 
 =over 4
 
 =item *
 
-David Golden <dagolden@cpan.org>
+Tim Jenness <t.jenness@jach.hawaii.edu>
 
 =item *
 
@@ -3620,23 +3643,27 @@ Karen Etheridge <ether@cpan.org>
 
 =item *
 
-Slaven Rezic <slaven@rezic.de>
+David Golden <dagolden@cpan.org>
 
 =item *
 
-Peter Rabbitson <ribasushi@cpan.org>
+Slaven Rezic <srezic@cpan.org>
 
 =item *
 
-Olivier Mengue <dolmen@cpan.org>
+mohawk2 <mohawk2@users.noreply.github.com>
 
 =item *
 
-David Golden <xdg@xdg.me>
+Roy Ivy III <rivy.dev@gmail.com>
 
 =item *
 
-Kevin Ryde <user42@zip.com.au>
+Peter Rabbitson <ribasushi@cpan.org>
+
+=item *
+
+Olivier Mengué <dolmen@cpan.org>
 
 =item *
 
@@ -3644,11 +3671,11 @@ Peter John Acklam <pjacklam@online.no>
 
 =item *
 
-Slaven Rezic <slaven.rezic@idealo.de>
+Tim Gim Yee <tim.gim.yee@gmail.com>
 
 =item *
 
-James E. Keenan <jkeen@verizon.net>
+Nicolas R <atoomic@cpan.org>
 
 =item *
 
@@ -3672,13 +3699,21 @@ Guillem Jover <guillem@hadrons.org>
 
 =item *
 
+James E. Keenan <jkeen@verizon.net>
+
+=item *
+
+Kevin Ryde <user42@zip.com.au>
+
+=item *
+
 Ben Tilly <btilly@gmail.com>
 
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2019 by Tim Jenness and the UK Particle Physics and Astronomy Research Council.
+This software is copyright (c) 2020 by Tim Jenness and the UK Particle Physics and Astronomy Research Council.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index d826ede..50e4ab6 100644 (file)
@@ -7,7 +7,7 @@ use strict;
 BEGIN {use_ok( "File::Temp" ); }
 
 {
-  my $fh = new File::Temp();
+  my $fh = File::Temp->new();
   isa_ok ($fh, 'File::Temp');
 
   ok( "$fh" ne "foo", "compare stringified object with string");
index fd3f5a6..019fab3 100644 (file)
@@ -12,10 +12,14 @@ BEGIN {
      $Config::Config{useithreads} and
      $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
     );
-  if ( $can_fork ) {
+  if ( $can_fork && !(($^O eq 'MSWin32') && $Devel::Cover::VERSION) ) {
     print "1..8\n";
   } else {
-    print "1..0 # Skip No fork available\n";
+    if ( ($^O eq 'MSWin32') && $Devel::Cover::VERSION ) {
+        print "1..0 # Skip Devel::Cover coverage testing is incompatible with fork under 'MSWin32'\n";
+    } else {
+        print "1..0 # Skip No fork available\n";
+    }
     exit;
   }
 }
@@ -38,8 +42,7 @@ for my $i (1 .. $children) {
   } else {
     # in a child we can't keep the count properly so we do it manually
     # make sure that child 1 dies first
-    srand();
-    my $time = (($i-1) * 5) +int(rand(5));
+    my $time = ($i-1) * 3;
     print "# child $i sleeping for $time seconds\n";
     sleep($time);
     my $count = $i + 1;
@@ -72,8 +75,7 @@ for my $i (1 .. $children) {
     # parent process
     next;
   } else {
-    srand();
-    my $time = (($i-1) * 5) +int(rand(5));
+    my $time = ($i-1) * 3;
     print "# child $i sleeping for $time seconds\n";
     sleep($time);
     my $count = 5 + $i;
index 0d7dfc0..7bcd491 100644 (file)
@@ -43,7 +43,7 @@ if ($@) {
 ok( !$status, "File $fh is locked" );
 
 # Now get a tempfile with locking disabled
-$fh = new File::Temp( EXLOCK => 0 );
+$fh = File::Temp->new( EXLOCK => 0 );
 
 eval {
    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
index 942de19..fd512a3 100644 (file)
@@ -41,7 +41,7 @@ like( $@, qr/can't be called as a method/, "File::Temp->tempfile error" );
 
 # Tempfile
 # Open tempfile in some directory, unlink at end
-my $fh = new File::Temp( SUFFIX => '.txt' );
+my $fh = File::Temp->new( SUFFIX => '.txt' );
 
 ok( (-f "$fh"), "File $fh exists"  );
 # Should still be around after closing
@@ -89,7 +89,7 @@ ok( (-d $tempdir), "Does $tempdir directory exist" );
 push(@dirs, $tempdir);
 
 # Create file in the temp dir
-$fh = new File::Temp(
+$fh = File::Temp->new(
                     DIR => $tempdir,
                     SUFFIX => '.dat',
                    );
@@ -102,7 +102,7 @@ push(@files, "$fh");
 
 # Test tempfile
 # ..and again (without unlinking it)
-$fh = new File::Temp( DIR => $tempdir, UNLINK => 0 );
+$fh = File::Temp->new( DIR => $tempdir, UNLINK => 0 );
 
 print "# TEMPFILE: Created $fh\n";
 ok( (-f "$fh" ), "Second file $fh exists in tempdir [nounlink]?");
@@ -110,7 +110,7 @@ push(@files, "$fh");
 
 # and another (with template)
 
-$fh = new File::Temp( TEMPLATE => 'helloXXXXXXX',
+$fh = File::Temp->new( TEMPLATE => 'helloXXXXXXX',
                      DIR => $tempdir,
                      SUFFIX => '.dat',
                    );
@@ -133,7 +133,7 @@ push(@files, "$fh");
 
 # Create a temporary file that should stay around after
 # it has been closed
-$fh = new File::Temp( TEMPLATE => 'permXXXXXXX', UNLINK => 0);
+$fh = File::Temp->new( TEMPLATE => 'permXXXXXXX', UNLINK => 0);
 
 print "# TEMPFILE: Created $fh\n";
 ok( -f "$fh", "File $fh exists?" );
@@ -143,7 +143,7 @@ push( @still_there, "$fh"); # check at END
 
 # Now create a temp file that will remain when the object
 # goes out of scope because of $KEEP_ALL
-$fh = new File::Temp( TEMPLATE => 'permXXXXXXX', UNLINK => 1);
+$fh = File::Temp->new( TEMPLATE => 'permXXXXXXX', UNLINK => 1);
 
 print "# TEMPFILE: Created $fh\n";
 ok( -f "$fh", "File $fh exists?" );
index c5c98d7..78a26bc 100644 (file)
@@ -35,7 +35,7 @@ sub dircontent {
   my $tempdirstr = shift;
   my $str = "Contents of $dir (should not contain \"$tempdirstr\"):\n";
   opendir(my $DH, $dir) or die "opendir failed; $!";
-  my @contents = grep { $_ !~ /^\.+/; } readdir($DH);
+  my @contents = grep $_ !~ /^\.+/, readdir($DH);
   closedir($DH);
   for my $ls (@contents) {
     $str .= "  $ls\n";
index 3cb08d2..baef313 100644 (file)
@@ -2,7 +2,7 @@
 # Test for File::Temp - tempfile function
 
 use strict;
-use Test::More tests => 28;
+use Test::More tests => 30;
 use File::Spec;
 use Cwd qw/ cwd /;
 
@@ -100,13 +100,31 @@ ok( (-f $tempfile ), "Local tempfile in tempdir exists");
 push(@files, File::Spec->rel2abs($tempfile));
 
 # Test tempfile
-# ..and another with changed permissions (read-only)
+# ..and another with default permissions
 ($fh, $tempfile) = tempfile(
-                           DIR => $tempdir,
-                          );
-chmod 0444, $tempfile;
+                           DIR => $tempdir,
+                          );
+
+ok( (-f $tempfile && -r _ && -w _),
+    "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,
+                          );
 
-ok( (-f $tempfile ), "Local tempfile in tempdir exists read-only");
+# From perlport on chmod:
+#
+#     (Win32) Only good for changing "owner" read-write access;
+#     "group" and "other" bits are meaningless.
+#
+# So don't check actual file permissions -- it will be 0444 on Win32
+# instead of 0400.  Instead, just check that no longer writable.
+ok( (-f $tempfile && -r _ && ! -w _),
+    "Created tempfile with changed permissions" );
 push(@files, File::Spec->rel2abs($tempfile));
 
 print "# TEMPFILE: Created $tempfile\n";