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