1 | package File::stat;
|
---|
2 | use 5.006;
|
---|
3 |
|
---|
4 | use strict;
|
---|
5 | use warnings;
|
---|
6 |
|
---|
7 | our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
|
---|
8 |
|
---|
9 | our $VERSION = '1.00';
|
---|
10 |
|
---|
11 | BEGIN {
|
---|
12 | use Exporter ();
|
---|
13 | @EXPORT = qw(stat lstat);
|
---|
14 | @EXPORT_OK = qw( $st_dev $st_ino $st_mode
|
---|
15 | $st_nlink $st_uid $st_gid
|
---|
16 | $st_rdev $st_size
|
---|
17 | $st_atime $st_mtime $st_ctime
|
---|
18 | $st_blksize $st_blocks
|
---|
19 | );
|
---|
20 | %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
|
---|
21 | }
|
---|
22 | use vars @EXPORT_OK;
|
---|
23 |
|
---|
24 | # Class::Struct forbids use of @ISA
|
---|
25 | sub import { goto &Exporter::import }
|
---|
26 |
|
---|
27 | use Class::Struct qw(struct);
|
---|
28 | struct 'File::stat' => [
|
---|
29 | map { $_ => '$' } qw{
|
---|
30 | dev ino mode nlink uid gid rdev size
|
---|
31 | atime mtime ctime blksize blocks
|
---|
32 | }
|
---|
33 | ];
|
---|
34 |
|
---|
35 | sub populate (@) {
|
---|
36 | return unless @_;
|
---|
37 | my $stob = new();
|
---|
38 | @$stob = (
|
---|
39 | $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
|
---|
40 | $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks )
|
---|
41 | = @_;
|
---|
42 | return $stob;
|
---|
43 | }
|
---|
44 |
|
---|
45 | sub lstat ($) { populate(CORE::lstat(shift)) }
|
---|
46 |
|
---|
47 | sub stat ($) {
|
---|
48 | my $arg = shift;
|
---|
49 | my $st = populate(CORE::stat $arg);
|
---|
50 | return $st if $st;
|
---|
51 | my $fh;
|
---|
52 | {
|
---|
53 | local $!;
|
---|
54 | no strict 'refs';
|
---|
55 | require Symbol;
|
---|
56 | $fh = \*{ Symbol::qualify( $arg, caller() )};
|
---|
57 | return unless defined fileno $fh;
|
---|
58 | }
|
---|
59 | return populate(CORE::stat $fh);
|
---|
60 | }
|
---|
61 |
|
---|
62 | 1;
|
---|
63 | __END__
|
---|
64 |
|
---|
65 | =head1 NAME
|
---|
66 |
|
---|
67 | File::stat - by-name interface to Perl's built-in stat() functions
|
---|
68 |
|
---|
69 | =head1 SYNOPSIS
|
---|
70 |
|
---|
71 | use File::stat;
|
---|
72 | $st = stat($file) or die "No $file: $!";
|
---|
73 | if ( ($st->mode & 0111) && $st->nlink > 1) ) {
|
---|
74 | print "$file is executable with lotsa links\n";
|
---|
75 | }
|
---|
76 |
|
---|
77 | use File::stat qw(:FIELDS);
|
---|
78 | stat($file) or die "No $file: $!";
|
---|
79 | if ( ($st_mode & 0111) && $st_nlink > 1) ) {
|
---|
80 | print "$file is executable with lotsa links\n";
|
---|
81 | }
|
---|
82 |
|
---|
83 | =head1 DESCRIPTION
|
---|
84 |
|
---|
85 | This module's default exports override the core stat()
|
---|
86 | and lstat() functions, replacing them with versions that return
|
---|
87 | "File::stat" objects. This object has methods that
|
---|
88 | return the similarly named structure field name from the
|
---|
89 | stat(2) function; namely,
|
---|
90 | dev,
|
---|
91 | ino,
|
---|
92 | mode,
|
---|
93 | nlink,
|
---|
94 | uid,
|
---|
95 | gid,
|
---|
96 | rdev,
|
---|
97 | size,
|
---|
98 | atime,
|
---|
99 | mtime,
|
---|
100 | ctime,
|
---|
101 | blksize,
|
---|
102 | and
|
---|
103 | blocks.
|
---|
104 |
|
---|
105 | You may also import all the structure fields directly into your namespace
|
---|
106 | as regular variables using the :FIELDS import tag. (Note that this still
|
---|
107 | overrides your stat() and lstat() functions.) Access these fields as
|
---|
108 | variables named with a preceding C<st_> in front their method names.
|
---|
109 | Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
|
---|
110 | the fields.
|
---|
111 |
|
---|
112 | To access this functionality without the core overrides,
|
---|
113 | pass the C<use> an empty import list, and then access
|
---|
114 | function functions with their full qualified names.
|
---|
115 | On the other hand, the built-ins are still available
|
---|
116 | via the C<CORE::> pseudo-package.
|
---|
117 |
|
---|
118 | =head1 BUGS
|
---|
119 |
|
---|
120 | As of Perl 5.8.0 after using this module you cannot use the implicit
|
---|
121 | C<$_> or the special filehandle C<_> with stat() or lstat(), trying
|
---|
122 | to do so leads into strange errors. The workaround is for C<$_> to
|
---|
123 | be explicit
|
---|
124 |
|
---|
125 | my $stat_obj = stat $_;
|
---|
126 |
|
---|
127 | and for C<_> to explicitly populate the object using the unexported
|
---|
128 | and undocumented populate() function with CORE::stat():
|
---|
129 |
|
---|
130 | my $stat_obj = File::stat::populate(CORE::stat(_));
|
---|
131 |
|
---|
132 | =head1 NOTE
|
---|
133 |
|
---|
134 | While this class is currently implemented using the Class::Struct
|
---|
135 | module to build a struct-like class, you shouldn't rely upon this.
|
---|
136 |
|
---|
137 | =head1 AUTHOR
|
---|
138 |
|
---|
139 | Tom Christiansen
|
---|