Setting $_ to multiline glob in @INC filter

[perl5.git] / lib / File / stat.pm

diff --git a/lib/File/stat.pm b/lib/File/stat.pm
index 630fae1..b631fbf 100644 (file)
--- a/lib/File/stat.pm
+++ b/lib/File/stat.pm
@@ -10,7 +10,7 @@ BEGIN { *warnif = \&warnings::warnif }
 
 our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
-our $VERSION = '1.02';
+our $VERSION = '1.07';
 
 my @fields;
 BEGIN { 
@@ -37,17 +37,18 @@ BEGIN {
         my $val = eval { &{"Fcntl::S_I\U$_"} };
         *{"_$_"} = defined $val ? sub { $_[0] & $val ? 1 : "" } : sub { "" };
     }
-    for (qw(SOCK CHR BLK REG DIR FIFO LNK)) {
+    for (qw(SOCK CHR BLK REG DIR LNK)) {
         *{"S_IS$_"} = defined eval { &{"Fcntl::S_IF$_"} }
             ? \&{"Fcntl::S_IS$_"} : sub { "" };
     }
+    # FIFO flag and macro don't quite follow the S_IF/S_IS pattern above
+    # RT #111638
+    *{"S_ISFIFO"} = defined &Fcntl::S_IFIFO
+      ? \&Fcntl::S_ISFIFO : sub { "" };
 }
 
 # from doio.c
 sub _ingroup {
-
-    $^O eq "MacOS"  and return 1;
-    
     my ($gid, $eff)   = @_;
 
     # I am assuming that since VMS doesn't have getgroups(2), $) will
@@ -78,7 +79,7 @@ sub _ingroup {
 if (grep $^O eq $_, qw/os2 MSWin32 dos/) {
 
     # from doio.c
-    *cando = sub { ($_[0] & $_[2][2]) ? 1 : "" };
+    *cando = sub { ($_[0][2] & $_[1]) ? 1 : "" };
 }
 else {
 
@@ -86,13 +87,22 @@ else {
     *cando = sub {
         my ($s, $mode, $eff) = @_;
         my $uid = $eff ? $> : $<;
-
-        $^O ne "VMS" and $uid == 0  and return 1;
-
         my ($stmode, $stuid, $stgid) = @$s[2,4,5];
 
         # This code basically assumes that the rwx bits of the mode are
         # the 0777 bits, but so does Perl_cando.
+
+        if ($uid == 0 && $^O ne "VMS") {
+            # If we're root on unix
+            # not testing for executable status => all file tests are true
+            return 1 if !($mode & 0111);
+            # testing for executable status =>
+            # for a file, any x bit will do
+            # for a directory, always true
+            return 1 if $stmode & 0111 || S_ISDIR($stmode);
+            return "";
+        }
+
         if ($stuid == $uid) {
             $stmode & $mode         and return 1;
         }
@@ -149,7 +159,7 @@ use overload
     -X => sub {
         my ($s, $op) = @_;
 
-        if (index "rwxRWX", $op) {
+        if (index("rwxRWX", $op) >= 0) {
             (caller 0)[8] & HINT_FILETEST_ACCESS
                 and warnif("File::stat ignores use filetest 'access'");