1package File::Stat::Bits;
2
3=head1 NAME
4
5File::Stat::Bits - stat(2) bit mask constants
6
7=head1 SYNOPSIS
8
9 use File::stat;
10 use File::Stat::Bits;
11
12 my $st = stat($file) or die "Can't stat $file: $!";
13
14 if ( S_ISCHR($st->mode) ) {
15	my ($major, $minor) = dev_split( $st->rdev );
16
17	print "$file is character device $major:$minor\n";
18 }
19
20 printf "Permissions are %04o\n", $st->mode & ALLPERMS;
21
22
23(Too many S_IF* constants to example)
24
25
26=head1 DESCRIPTION
27
28Lots of Perl modules use the Unix file permissions and type bits directly
29in binary form with risk of non-portability for some exotic bits.
30Note that the POSIX module does not provides all needed constants
31and I can't wait when the POSIX module will be updated.
32
33This separate module provides file type/mode bit and more constants
34from sys/stat.ph and sys/sysmacros.ph without pollution caller's namespace
35by other unneeded symbols from these headers.
36Most of these constants exported by this module are Constant Functions
37(see L<perlsub>).
38
39Since some of Perl builds does not include these converted headers,
40the build procedure will generate it for itself in the its own lib directory.
41
42This module also should concentrate all portability and compatibility issues.
43
44=cut
45
46require 5.005;
47use strict;
48local $^W=1; # use warnings only since 5.006
49use integer;
50
51BEGIN
52{
53    use Exporter;
54    use vars qw($VERSION @ISA @EXPORT);
55
56    $VERSION = do { my @r = (q$Revision: 0.19 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
57
58    @ISA = ('Exporter');
59
60    @EXPORT = qw(
61	S_IRWXU S_IRUSR S_IWUSR S_IXUSR S_ISUID
62	S_IRWXG S_IRGRP S_IWGRP S_IXGRP S_ISGID
63	S_IRWXO S_IROTH S_IWOTH S_IXOTH S_ISVTX
64
65	ACCESSPERMS ALLPERMS DEFFILEMODE
66
67	S_IFMT S_IFDIR  S_IFCHR  S_IFBLK  S_IFREG   S_IFIFO  S_IFLNK  S_IFSOCK
68
69	      &S_ISDIR &S_ISCHR &S_ISBLK &S_ISREG &S_ISFIFO &S_ISLNK &S_ISSOCK
70
71	&major &minor &dev_split &dev_join
72    );
73
74    {
75	package File::Stat::Bits::dirty;
76
77	use File::Basename;
78	use lib dirname(__FILE__) . '/Bits';
79	local $^W=0;
80	no strict;
81	require 'stat.ph';
82    }
83
84
85=head1 CONSTANTS
86
87=head2
88
89File type bit masks (for the st_mode field):
90
91 S_IFMT		bitmask for the file type bitfields
92 S_IFDIR	directory
93 S_IFCHR	character device
94 S_IFBLK	block device
95 S_IFREG	regular file
96 S_IFIFO	fifo (named pipe)
97 S_IFLNK	symbolic link
98 S_IFSOCK	socket
99=cut
100
101    sub S_IFMT  () { File::Stat::Bits::dirty::S_IFMT  () }
102    sub S_IFDIR () { File::Stat::Bits::dirty::S_IFDIR () }
103    sub S_IFCHR () { File::Stat::Bits::dirty::S_IFCHR () }
104    sub S_IFBLK () { File::Stat::Bits::dirty::S_IFBLK () }
105    sub S_IFREG () { File::Stat::Bits::dirty::S_IFREG () }
106    sub S_IFIFO () { File::Stat::Bits::dirty::S_IFIFO () }
107    sub S_IFLNK () { File::Stat::Bits::dirty::S_IFLNK () }
108    sub S_IFSOCK() { File::Stat::Bits::dirty::S_IFSOCK() }
109
110
111=head2
112
113File access permission bit masks (for the st_mode field):
114
115 S_IRWXU	mask for file owner permissions
116 S_IRUSR	owner has read permission
117 S_IWUSR	owner has write permission
118 S_IXUSR	owner has execute permission
119 S_ISUID	set UID bit
120
121 S_IRWXG	mask for group permissions
122 S_IRGRP	group has read permission
123 S_IWGRP	group has write permission
124 S_IXGRP	group has execute permission
125 S_ISGID	set GID bit
126
127 S_IRWXO	mask for permissions for others
128 S_IROTH	others have read permission
129 S_IWOTH	others have write permisson
130 S_IXOTH	others have execute permission
131 S_ISVTX	sticky bit
132
133Common mode bit masks:
134
135 ACCESSPERMS	 0777
136    ALLPERMS	07777
137 DEFFILEMODE	 0666
138=cut
139
140    sub S_IRWXU() { File::Stat::Bits::dirty::S_IRWXU() }
141    sub S_IRUSR() { File::Stat::Bits::dirty::S_IRUSR() }
142    sub S_IWUSR() { File::Stat::Bits::dirty::S_IWUSR() }
143    sub S_IXUSR() { File::Stat::Bits::dirty::S_IXUSR() }
144    sub S_ISUID() { File::Stat::Bits::dirty::S_ISUID() }
145
146    sub S_IRWXG() { File::Stat::Bits::dirty::S_IRWXG() }
147    sub S_IRGRP() { File::Stat::Bits::dirty::S_IRGRP() }
148    sub S_IWGRP() { File::Stat::Bits::dirty::S_IWGRP() }
149    sub S_IXGRP() { File::Stat::Bits::dirty::S_IXGRP() }
150    sub S_ISGID() { File::Stat::Bits::dirty::S_ISGID() }
151
152    sub S_IRWXO() { File::Stat::Bits::dirty::S_IRWXO() }
153    sub S_IROTH() { File::Stat::Bits::dirty::S_IROTH() }
154    sub S_IWOTH() { File::Stat::Bits::dirty::S_IWOTH() }
155    sub S_IXOTH() { File::Stat::Bits::dirty::S_IXOTH() }
156    sub S_ISVTX() { File::Stat::Bits::dirty::S_ISVTX() }
157
158
159    sub ACCESSPERMS()	{ S_IRWXU|S_IRWXG|S_IRWXO }
160    sub    ALLPERMS()	{ S_ISUID|S_ISGID|S_ISVTX|ACCESSPERMS }
161    sub DEFFILEMODE()	{ S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH }
162
163
164=head1 FUNCTIONS
165
166=head2
167
168File type test macros (for the st_mode field):
169
170 S_ISDIR ( mode )	directory?
171 S_ISCHR ( mode )	character device?
172 S_ISBLK ( mode )	block device?
173 S_ISREG ( mode )	regular file?
174 S_ISFIFO( mode )	fifo (named pipe)?
175 S_ISLNK ( mode )	is it a symbolic link?
176 S_ISSOCK( mode )	socket?
177
178All returns boolean value.
179
180=cut
181    sub s_istype
182    {
183	my ($mode, $mask) = @_;
184	(($mode & S_IFMT) == ($mask));
185    }
186
187    sub S_ISDIR  { my ($mode) = @_; s_istype($mode, S_IFDIR ) }
188    sub S_ISCHR  { my ($mode) = @_; s_istype($mode, S_IFCHR ) }
189    sub S_ISBLK  { my ($mode) = @_; s_istype($mode, S_IFBLK ) }
190    sub S_ISREG  { my ($mode) = @_; s_istype($mode, S_IFREG ) }
191    sub S_ISFIFO { my ($mode) = @_; s_istype($mode, S_IFIFO ) }
192    sub S_ISLNK  { my ($mode) = @_; s_istype($mode, S_IFLNK ) }
193    sub S_ISSOCK { my ($mode) = @_; s_istype($mode, S_IFSOCK) }
194}
195
196
197=head2
198
199$major = major( $st_rdev )
200
201Returns major device number of st_rdev
202
203=cut
204
205sub major
206{
207    my $dev = shift;
208
209    package File::Stat::Bits::dirty;
210
211    return defined MAJOR_MASK ? ($dev & MAJOR_MASK) >> MAJOR_SHIFT : undef;
212}
213
214
215=head2
216
217$minor = minor( $st_rdev )
218
219Returns minor device number of st_rdev
220
221=cut
222
223sub minor
224{
225    my $dev = shift;
226
227    package File::Stat::Bits::dirty;
228
229    return defined MINOR_MASK ? ($dev & MINOR_MASK) >> MINOR_SHIFT : undef;
230}
231
232
233=head2
234
235($major, $minor) = dev_split( $st_rdev )
236
237Splits st_rdev to major and minor device numbers
238
239=cut
240
241sub dev_split
242{
243    my $dev = shift;
244    return ( major($dev), minor($dev) );
245}
246
247
248=head2
249
250$st_rdev = dev_join( $major, $minor )
251
252Makes st_rdev from major and minor device numbers (makedev())
253
254=cut
255
256sub dev_join
257{
258    my ($major, $minor) = @_;
259
260    package File::Stat::Bits::dirty;
261
262    if ( defined MAJOR_SHIFT )
263    {
264	return
265	    (($major << MAJOR_SHIFT) & MAJOR_MASK) |
266	    (($minor << MINOR_SHIFT) & MINOR_MASK);
267    }
268    else
269    {
270	return undef;
271    }
272}
273
274
275=head1 NOTE
276
277If major/minor definitions absent in reasonable set of system C headers
278all major/minor related functions returns undef.
279
280=cut
281
282
283=head1 SEE ALSO
284
285L<stat(2)>
286
287L<File::stat(3)>
288
289
290=head1 AUTHOR
291
292Dmitry Fedorov <dm.fedorov@gmail.com>
293
294=head1 COPYRIGHT
295
296Copyright (C) 2003 Dmitry Fedorov <dm.fedorov@gmail.com>
297
298=head1 LICENSE
299
300This program is free software; you can redistribute it and/or modify
301it under the terms of the GNU General Public License as published by
302the Free Software Foundation; either version 2 of the License,
303or (at your option) any later version.
304
305=head1 DISCLAIMER
306
307The author disclaims any responsibility for any mangling of your system
308etc, that this script may cause.
309
310=cut
311
312
3131;
314
315