diff --git a/lib/File/stat-7896.t b/lib/File/stat-7896.t index 57b268585203..7b049892c944 100644 --- a/lib/File/stat-7896.t +++ b/lib/File/stat-7896.t @@ -9,7 +9,7 @@ use File::stat; # should be revisited is($INC{'Symbol.pm'}, undef, "Symbol isn't loaded yet"); -# ID 20011110.104 (RT #7896) +# ID 20011110.104 (RT #7896 / GH #4572) $! = 0; is($!, '', '$! is empty'); is(File::stat::stat('/notafile'), undef, 'invalid file should fail'); diff --git a/lib/File/stat.pm b/lib/File/stat.pm index 192df7bbdb42..9b1eeb569f85 100644 --- a/lib/File/stat.pm +++ b/lib/File/stat.pm @@ -16,12 +16,12 @@ our ( $st_dev, $st_ino, $st_mode, use Exporter 'import'; our @EXPORT = qw(stat lstat); -our @fields = qw( $st_dev $st_ino $st_mode - $st_nlink $st_uid $st_gid - $st_rdev $st_size - $st_atime $st_mtime $st_ctime - $st_blksize $st_blocks - ); +our @fields = qw( $st_dev $st_ino $st_mode + $st_nlink $st_uid $st_gid + $st_rdev $st_size + $st_atime $st_mtime $st_ctime + $st_blksize $st_blocks + ); our @EXPORT_OK = ( @fields, "stat_cando" ); our %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] ); @@ -73,7 +73,7 @@ sub _ingroup { # and interpreting it later would require this module to have an XS # component (at which point we might as well just call Perl_cando and # have done with it). - + if (grep $^O eq $_, qw/os2 MSWin32/) { # from doio.c @@ -152,7 +152,7 @@ my %op = ( use constant HINT_FILETEST_ACCESS => 0x00400000; # we need fallback=>1 or stringifying breaks -use overload +use overload fallback => 1, -X => sub { my ($s, $op) = @_; @@ -179,28 +179,28 @@ use overload use Class::Struct qw(struct); struct 'File::stat' => [ map { $_ => '$' } qw{ - dev ino mode nlink uid gid rdev size - atime mtime ctime blksize blocks + dev ino mode nlink uid gid rdev size + atime mtime ctime blksize blocks } ]; sub populate { - return unless @_; + return undef unless @_; my $stob = new(); @$stob = ( - $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, - $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) - = @_; + $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, + $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) + = @_; return $stob; -} +} -sub lstat :prototype($) { populate(CORE::lstat(shift)) } +sub lstat :prototype(_) ($arg) { + populate(CORE::lstat $arg) +} -sub stat :prototype($) { - my $arg = shift; +sub stat :prototype(_) ($arg) { my $st = populate(CORE::stat $arg); - return $st if defined $st; - return if ref $arg; + return $st if defined $st || ref $arg; # ... maybe $arg is the name of a bareword handle? my $fh; { @@ -208,7 +208,7 @@ sub stat :prototype($) { no strict 'refs'; require Symbol; $fh = \*{ Symbol::qualify( $arg, caller() )}; - return unless defined fileno $fh; + return undef unless defined fileno $fh; } return populate(CORE::stat $fh); } @@ -221,34 +221,34 @@ File::stat - by-name interface to Perl's built-in stat() functions =head1 SYNOPSIS - use File::stat; - my $st = stat($file) or die "No $file: $!"; - if ( ($st->mode & 0111) && ($st->nlink > 1) ) { - print "$file is executable with lotsa links\n"; - } + use File::stat; + my $st = stat($file) or die "No $file: $!"; + if ( ($st->mode & 0111) && ($st->nlink > 1) ) { + print "$file is executable with lotsa links\n"; + } - if ( -x $st ) { - print "$file is executable\n"; - } + if ( -x $st ) { + print "$file is executable\n"; + } - use Fcntl "S_IRUSR"; - if ( $st->cando(S_IRUSR, 1) ) { - print "My effective uid can read $file\n"; - } + use Fcntl "S_IRUSR"; + if ( $st->cando(S_IRUSR, 1) ) { + print "My effective uid can read $file\n"; + } - use File::stat qw(:FIELDS); - stat($file) or die "No $file: $!"; - if ( ($st_mode & 0111) && ($st_nlink > 1) ) { - print "$file is executable with lotsa links\n"; - } + use File::stat qw(:FIELDS); + stat($file) or die "No $file: $!"; + if ( ($st_mode & 0111) && ($st_nlink > 1) ) { + print "$file is executable with lotsa links\n"; + } =head1 DESCRIPTION -This module's default exports override the core stat() -and lstat() functions, replacing them with versions that return +This module's default exports override the core stat() +and lstat() functions, replacing them with versions that return "File::stat" objects. This object has methods that return the similarly named structure field name from the -stat(2) function; namely, +L function; namely, dev, ino, mode, @@ -262,13 +262,13 @@ mtime, ctime, blksize, and -blocks. +blocks. As of version 1.02 (provided with perl 5.12) the object provides C<"-X"> overloading, so you can call filetest operators (C<-f>, C<-x>, and so on) on it. It also provides a C<< ->cando >> method, called like - $st->cando( ACCESS, EFFECTIVE ) + $st->cando( ACCESS, EFFECTIVE ) where I is one of C, C or C from the L module, and I indicates whether to use @@ -288,23 +288,41 @@ variables named with a preceding C in front their method names. Thus, C<$stat_obj-Edev()> corresponds to $st_dev if you import the fields. -To access this functionality without the core overrides, -pass the C an empty import list, and then access -function functions with their full qualified names. -On the other hand, the built-ins are still available -via the C pseudo-package. +To access this functionality without the core overrides, pass the C +an empty import list, and then access functions with their full qualified +names: + + use File::stat (); + my $st = File::stat::stat($file); + +On the other hand, the built-ins are still available via the C +pseudo-package even if you let File::stat override them: + + use File::stat; + my ($dev, $ino, $mode) = CORE::stat($file); + +As of version 1.15 (provided with perl 5.44) C and C can be +called without arguments, in which case C<$_> is used (just like the +built-in C/C functions): + + my $st_1 = stat; # stat($_) + my $st_2 = lstat; # lstat($_) =head1 BUGS -As of Perl 5.8.0 after using this module you cannot use the implicit -C<$_> or the special filehandle C<_> with stat() or lstat(), trying -to do so leads into strange errors. The workaround is for C<$_> to -be explicit +The built-in C and C functions recognize the special +filehandle C<_> (underscore) to indicate that no actual C be done; +instead the results of the last C or C or filetest operation +should be returned. This syntax does not work with File::stat, but the +same result can be achieved by passing C a reference to the C<*_> +typeglob: - my $stat_obj = stat $_; + use File::stat; + my $stat_obj = stat \*_; # reuse results of last stat operation -and for C<_> to explicitly populate the object using the unexported -and undocumented populate() function with CORE::stat(): +Alternatively, another workaround is to explicitly populate the object +using the unexported and undocumented populate() function with +CORE::stat(): my $stat_obj = File::stat::populate(CORE::stat(_)); @@ -344,7 +362,7 @@ do not, since the information required is not available. =head1 NOTE -While this class is currently implemented using the Class::Struct +While this class is currently implemented using the L module to build a struct-like class, you shouldn't rely upon this. =head1 AUTHOR diff --git a/lib/File/stat.t b/lib/File/stat.t index 0175a9304b3f..7a385090ec03 100644 --- a/lib/File/stat.t +++ b/lib/File/stat.t @@ -154,32 +154,32 @@ for (split //, "tTB") { } SKIP: { - skip("Could not open file: $!", 2) unless $canopen; - isa_ok(File::stat::stat('STAT'), 'File::stat', - '... should be able to find filehandle'); - - package foo; - local *STAT = *main::STAT; - my $stat2 = File::stat::stat('STAT'); - main::isa_ok($stat2, 'File::stat', - '... and filehandle in another package'); - close STAT; - -# VOS open() updates atime; ignore this error (posix-975). - my $stat3 = $stat2; - if ($^O eq 'vos') { - $$stat3[8] = $$stat[8]; - } + skip("Could not open file: $!", 2) unless $canopen; + isa_ok(File::stat::stat('STAT'), 'File::stat', + '... should be able to find filehandle'); + + package foo; + local *STAT = *main::STAT; + my $stat2 = File::stat::stat('STAT'); + main::isa_ok($stat2, 'File::stat', + '... and filehandle in another package'); + close STAT; + +# VOS open() updates atime; ignore this error (posix-975). + my $stat3 = $stat2; + if ($^O eq 'vos') { + $$stat3[8] = $$stat[8]; + } - main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32'; + main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32'; - main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2'; + main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2'; - main::is_deeply($stat, $stat3, '... and must match normal stat'); + main::is_deeply($stat, $stat3, '... and must match normal stat'); } SKIP: -{ # RT #111638 +{ # RT #111638 / GH #11992 skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO; skip "No pipes", 2 unless defined $Config{d_pipe}; pipe my ($rh, $wh) @@ -225,6 +225,34 @@ SKIP: is stat({}), undef, 'stat({}) fails by returning undef'; } +{ + # list context + + my @ret = stat '/ no such file'; + is scalar(@ret), 1, 'stat returns one value in list context on failure'; + is $ret[0], undef, 'stat returns undef on failure'; + + @ret = stat $file; + is scalar(@ret), 1, 'stat returns one value in list context on success'; + isa_ok $ret[0], 'File::stat', 'successful stat in list context'; +} + +{ + # implicit $_ + $_ = $file; + my $st_1 = stat; + isa_ok $st_1, 'File::stat', 'stat()'; + + # reuse stat buffer + my $st_2 = stat \*_; + isa_ok $st_2, 'File::stat', 'stat(\\*_)'; + # we can't verify directly that no actual stat() was done, but we can check + # that the returned device/inode match those of $file even though *_{IO} + # (the actual _ handle) was never opened + is $st_1->dev, $st_2->dev, 'stat(\\*_)->dev matches that of last stat()'; + is $st_1->ino, $st_2->ino, 'stat(\\*_)->ino matches that of last stat()'; +} + # Testing pretty much anything else is unportable. done_testing; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 25690a3852de..830944a88fcb 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -135,9 +135,29 @@ XXX Remove this section if F did not add any cont =item * -L has been upgraded from version A.xx to B.yy. +L has been upgraded from version 1.14 to 1.15. -XXX If there was something important to note about this change, include that here. +=over 4 + +=item * + +The overridden C and C functions now always return a scalar value, +even in list context. Previously a failed stat in list context would return an +empty list; now it returns C. + +=item * + +C and C can now be called without an argument, in which case they +will use C<$_>, just like the built-in C/C functions. + +=item * + +It is now safe to pass path objects (e.g. instances of L) to +C/C. Previously a failed stat operation on such an object would +die with a cryptic C error. +[GH #23507] + +=back =back diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index f0f31b52db8f..bb1db7311d70 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -255,6 +255,7 @@ Padre PadWalker Parse::Keyword passwd(1) +Path::Tiny pclose(3) perl(1) Perl4::CoreLibs