This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File::Path: sync with CPAN version 2.16
authorJames E Keenan <jkeenan@cpan.org>
Sat, 8 Sep 2018 23:51:26 +0000 (19:51 -0400)
committerJames E Keenan <jkeenan@cpan.org>
Sat, 8 Sep 2018 23:51:26 +0000 (19:51 -0400)
Porting/Maintainers.pl
cpan/File-Path/lib/File/Path.pm
cpan/File-Path/t/Path_root.t
pod/perldelta.pod

index 26e768c..8172091 100755 (executable)
@@ -504,7 +504,7 @@ use File::Glob qw(:case);
     },
 
     'File::Path' => {
-        'DISTRIBUTION' => 'JKEENAN/File-Path-2.15.tar.gz',
+        'DISTRIBUTION' => 'JKEENAN/File-Path-2.16.tar.gz',
         'FILES'        => q[cpan/File-Path],
         'EXCLUDED'     => [
             qw(t/Path-Class.t),
index b4fb5a2..22e53f8 100644 (file)
@@ -18,7 +18,7 @@ BEGIN {
 
 use Exporter ();
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION   = '2.15';
+$VERSION   = '2.16';
 $VERSION   = eval $VERSION;
 @ISA       = qw(Exporter);
 @EXPORT    = qw(mkpath rmtree);
@@ -633,7 +633,7 @@ File::Path - Create or remove directory trees
 
 =head1 VERSION
 
-2.15 - released June 07 2017.
+2.16 - released August 31 2018.
 
 =head1 SYNOPSIS
 
@@ -1277,7 +1277,7 @@ Contributors to File::Path, in alphabetical order by first name.
 =head1 COPYRIGHT
 
 This module is copyright (C) Charles Bailey, Tim Bunce, David Landgren,
-James Keenan and Richard Elberger 1995-2017. All rights reserved.
+James Keenan and Richard Elberger 1995-2018. All rights reserved.
 
 =head1 LICENSE
 
index 2647b7f..8af39f7 100644 (file)
@@ -64,23 +64,23 @@ is($dir_gid, $max_gid, "... owned by group $max_gid");
 
 {
   # invent a user and group that don't exist
-  do { ++$max_user  } while ( getpwnam( $max_user ) );
-  do { ++$max_group } while ( getgrnam( $max_group ) );
+  my $phony_user = get_phony_user();
+  my $phony_group = get_phony_group();
 
   $dir = catdir($dir_stem, 'aad');
   my $rv = _run_for_warning( sub {
       make_path(
           $dir,
-          { user => $max_user, group => $max_group }
+          { user => $phony_user, group => $phony_group }
       )
   } );
   like( $rv,
-    qr{unable to map $max_user to a uid, ownership not changed:}s,
-    "created a directory not owned by $max_user:$max_group...",
+    qr{unable to map $phony_user to a uid, ownership not changed:}s,
+    "created a directory not owned by $phony_user:$phony_group...",
   );
   like( $rv,
-    qr{unable to map $max_group to a gid, group ownership not changed:}s,
-    "created a directory not owned by $max_user:$max_group...",
+    qr{unable to map $phony_group to a gid, group ownership not changed:}s,
+    "created a directory not owned by $phony_user:$phony_group...",
   );
 }
 
@@ -137,3 +137,30 @@ sub prereq {
   return "getgrent() appears to be insane" unless $max_gid > 0;
   return undef;
 }
+
+sub get_phony_user {
+    return "getpwent() not implemented on $^O" unless $Config{d_getpwent};
+    return "not running as root" unless $< == 0;
+    my %real_users = ();
+    while(my @a=getpwent()) {
+        $real_users{$a[0]}++;
+    }
+    my $phony_stem = 'phonyuser';
+    my $phony = '';
+    do { $phony = $phony_stem . int(rand(10000)); } until (! $real_users{$phony});
+    return $phony;
+}
+
+sub get_phony_group {
+    return "getgrent() not implemented on $^O" unless $Config{d_getgrent};
+    return "not running as root" unless $< == 0;
+    my %real_groups = ();
+    while(my @a=getgrent()) {
+        $real_groups{$a[0]}++;
+    }
+    my $phony_stem = 'phonygroup';
+    my $phony = '';
+    do { $phony = $phony_stem . int(rand(10000)); } until (! $real_groups{$phony});
+    return $phony;
+}
+
index 1f25335..8ee512f 100644 (file)
@@ -125,6 +125,10 @@ XXX Remove this section if not applicable.
 
 =item *
 
+L<File::Path> has been upgraded from version 2.15 to 2.16.
+
+=item *
+
 L<XXX> has been upgraded from version A.xx to B.yy.
 
 If there was something important to note about this change, include that here.