cpan/File-Path/t/Path_root.t

   1 use strict;
   2 use Test::More;
   3 use Config;
   4 use lib 't/';
   5 use FilePathTest;
   6 use File::Path qw(rmtree mkpath make_path remove_tree);
   7 use File::Spec::Functions;
   8
   9
  10 my $prereq = prereq();
  11 plan skip_all  => $prereq if defined $prereq;
  12 plan tests     => 8;
  13
  14 my $pwent = max_u();
  15 my $grent = max_g();
  16 my ( $max_uid, $max_user ) = @{ $pwent };
  17 my ( $max_gid, $max_group ) = @{ $grent };
  18
  19 my $tmp_base = catdir(
  20     curdir(),
  21     sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ),
  22 );
  23
  24 # invent some names
  25 my @dir = (
  26     catdir($tmp_base, qw(a b)),
  27     catdir($tmp_base, qw(a c)),
  28     catdir($tmp_base, qw(z b)),
  29     catdir($tmp_base, qw(z c)),
  30 );
  31
  32 # create them
  33 my @created = mkpath([@dir]);
  34
  35 my $dir;
  36 my $dir2;
  37
  38 my $dir_stem = $dir = catdir($tmp_base, 'owned-by');
  39
  40 $dir = catdir($dir_stem, 'aaa');
  41 @created = make_path($dir, {owner => $max_user});
  42 is(scalar(@created), 2, "created a directory owned by $max_user...");
  43
  44 my $dir_uid = (stat $created[0])[4];
  45 is($dir_uid, $max_uid, "... owned by $max_uid");
  46
  47 $dir = catdir($dir_stem, 'aab');
  48 @created = make_path($dir, {group => $max_group});
  49 is(scalar(@created), 1, "created a directory owned by group $max_group...");
  50
  51 my $dir_gid = (stat $created[0])[5];
  52 is($dir_gid, $max_gid, "... owned by group $max_gid");
  53
  54 $dir = catdir($dir_stem, 'aac');
  55 @created = make_path( $dir, { user => $max_user,
  56                               group => $max_group});
  57 is(scalar(@created), 1, "created a directory owned by $max_user:$max_group...");
  58
  59 ($dir_uid, $dir_gid) = (stat $created[0])[4,5];
  60 is($dir_uid, $max_uid, "... owned by $max_uid");
  61 is($dir_gid, $max_gid, "... owned by group $max_gid");
  62
  63 SKIP: {
  64   skip('Skip until RT 85878 is fixed', 1);
  65   # invent a user and group that don't exist
  66   do { ++$max_user  } while ( getpwnam( $max_user ) );
  67   do { ++$max_group } while ( getgrnam( $max_group ) );
  68
  69   $dir = catdir($dir_stem, 'aad');
  70   my $rv = _run_for_warning( sub { make_path( $dir,
  71                                               { user => $max_user,
  72                                                 group => $max_group } ) } );
  73   like( $rv,
  74         qr{\Aunable to map $max_user to a uid, ownership not changed: .* at \S+ line \d+
  75 unable to map $max_group to a gid, group ownership not changed: .* at \S+ line \d+\b},
  76         "created a directory not owned by $max_user:$max_group..."
  77       );
  78 }
  79
  80 sub max_u {
  81   # find the highest uid ('nobody' or similar)
  82   my $max_uid   = 0;
  83   my $max_user = undef;
  84   while (my @u = getpwent()) {
  85     if ($max_uid < $u[2]) {
  86       $max_uid  = $u[2];
  87       $max_user = $u[0];
  88     }
  89   }
  90   setpwent(); # in case we want to run again later
  91   return [ $max_uid, $max_user ];
  92 }
  93
  94 sub max_g {
  95   # find the highest gid ('nogroup' or similar)
  96   my $max_gid   = 0;
  97   my $max_group = undef;
  98   while ( my @g = getgrent() ) {
  99     print Dumper @g;
 100     if ($max_gid < $g[2]) {
 101       $max_gid = $g[2];
 102       $max_group = $g[0];
 103     }
 104   }
 105   setgrent(); # in case we want to run again later
 106   return [ $max_gid, $max_group ];
 107 }
 108
 109 sub prereq {
 110   return "getpwent() not implemented on $^O" unless $Config{d_getpwent};
 111   return "getgrent() not implemented on $^O" unless $Config{d_getgrent};
 112   return "not running as root" unless $< == 0;
 113   return "darwin's nobody and nogroup are -1 or -2" if $^O eq 'darwin';
 114
 115   my $pwent = max_u();
 116   my $grent = max_g();
 117   my ( $max_uid, $max_user ) = @{ $pwent };
 118   my ( $max_gid, $max_group ) = @{ $grent };
 119
 120   return "getpwent() appears to be insane" unless $max_uid > 0;
 121   return "getgrent() appears to be insane" unless $max_gid > 0;
 122   return undef;
 123 }