diff --git a/lsMode.pm b/lsMode.pm deleted file mode 100644 index 5aa6c6e..0000000 --- a/lsMode.pm +++ /dev/null @@ -1,289 +0,0 @@ -# -# -# Stat::lsMode -# -# Copyright 1998 M-J. Dominus -# (mjd-perl-lsmode-id-i0k+gzzokd+@plover.com) -# -# You may distribute this module under the same terms as Perl itself. -# -# $Revision: 1.3 $ $Date: 1998/04/20 18:24:53 $ - - -package lsMode; - -$VERSION = '0.50'; - -use Carp; -use Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(format_mode file_mode format_perms lsmode); - -@perms = qw(--- --x -w- -wx r-- r-x rw- rwx); -%smerp = map {$perms[$_] => $_} (0 .. $#perms); -@ftype = ('', qw(p c ? d ? b ? - ? l ? s ? ? ?)); -%typef = map {$ftype[$_] => $_} (0 .. $#ftype); - -$NOVICE_MODE = 1; # Default on? -sub novice { - my $pack = shift; - croak "novice_mode requires one boolean argument" unless @_ == 1; - my $old = $NOVICE_MODE; # Should this be localized t $pack? - $NOVICE_MODE = $_[0]; - $old; -} - -sub format_mode { - croak "format_mode requires a mode as an argument" unless @_ >= 1; - my $mode = shift; - my %opts = @_; - - unless (defined $mode) { - return wantarray() ? () : undef; - } - - _novice_warning($mode) if $NOVICE_MODE; - - my $setids = ($mode & 07000)>>9; - my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007]; - my $ftype = $ftype[($mode & 0170000)>>12]; - my @ftype = $opts{no_ftype} ? () : ($ftype); - - if ($setids) { - if ($setids & 01) { # Sticky bit - $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e; - } - if ($setids & 04) { # Setuid bit - $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e; - } - if ($setids & 02) { # Setgid bit - # Maybe substr($permstrs[1], -1) =~ tr/-x/Ss/; instead. LOD! - $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e; - } - } - - if (wantarray) { - (@ftype, @permstrs); - } else { - join '', @ftype, @permstrs; - } -} - -sub file_mode { - croak "file_mode requires one filename as an argument" unless @_ == 1; - my $file = shift; - my $mode = (lstat $file)[2]; - - unless (defined $mode) { - if (wantarray) { - return (); - } else { - carp "Couldn't get mode for file `$file': $!" if $NOVICE_MODE; - return undef; - } - } - - format_mode($mode, @_); -} - - -# This was suggested by Colin Kuskie -sub lsmode { - my $lsmode = shift; - my ($t, $u, $g, $o); - my $ld; - - if (length($lsmode) == 9) { - ($u, $g, $o) = unpack "A3 A3 A3", $lsmode; - $ld = 0; - } elsif (length($lsmode) == 10) { - ($t, $u, $g, $o) = unpack "A1 A3 A3 A3", $lsmode; - $ld = $typef{$t} - or croak("Mode `$lsmode' begins with unrecognized character `$t'"); - $ld = sprintf "%01o", $ld; - } else { - croak "Unrecognizable mode `$lsmode'"; - } - - # Fix sticky bit? - if ($o =~ /s$/i) { - croak "Mode `$lsmode' may not end with `s'; aborting"; - } - - my $octperm = ''; - my $setuid = 0; - foreach $perm ($u, $g, $o) { - # LOD - $setuid = $setuid * 2 + ($perm =~ s/([st])$/($1 eq lc $1)?'x':'-'/ie); - $octperm .= $smerp{$perm}; - } - - my $perm = oct(sprintf "0$ld$setuid$octperm"); - $perm; -} - - -sub format_perms { - croak "format_perms requires a permission mode as an argument" unless @_ == 1; - format_mode($_[0], no_ftype => 1); -} - -# None of these are really plausible modes. -# They are all almost certain to have occurred -# when someone used decimal instead of octal to specify a mode. - -@badmodes = (777, 775, 755, 770, 700, 750, - 751, - 666, 664, 644, 660, 600, 640, - 444, 440, - 400, # 400 = rw--w---- which is just barely plausible. - # 000 *is* OK. It means just what you think. - 711, 771, 751, 551, 111, - ); -%badmode = map {($_ => 1)} @badmodes; - -# Novices like to ask for the bits for mode `666' instead of `0666'. -# Try to detect and diagnose that. -sub _novice_warning { - my $mode = shift; - if ($badmode{$mode}) { - carp "mode $mode is very surprising. Perhaps you meant 0$mode"; - } -} - -=head1 NAME - -Stat::lsMode - format file modes like the C command does - -=head1 SYNOPSIS - - use Stat::lsMode; - - $mode = (stat $file)[2]; - $permissions = format_mode($mode); - # $permissions is now something like `drwxr-xr-x' - - $permissions = file_mode($file); # Same as above - - $permissions = format_perms(0644); # Produces just 'rw-r--r--' - - $permissions = format_perms(644); # This generates a warning message: - # mode 644 is very surprising. Perhaps you meant 0644... - - Stat::lsMode->novice(0); # Disable warning messages - -=head1 DESCRIPTION - -C generates mode and permission strings that look like -the ones generated by the Unix C command. For example, a -regular file that is readable by everyone and writable only by its -owner has the mode string C<-rw-r--r-->. C will either -examine the file and produce the right mode string for you, or you can -pass it the mode that you get back from Perl's C call. - -=head2 C - -Given a mode number (such as the third element of the list returned by -C), return the appopriate ten-character mode string as it would -have been generated by C. For example, -consider a directory that is readable and searchable by everyone, and -also writable by its owner. Such a directory will have mode 040755. -When passed this value, C will return the string -C. - -If C is passed a permission number like C<0755>, it will -return a nine-character string insted, with no leading character to -say what the file type is. For example, C will -return just C, without the leading C. - -=head2 C - -Given a filename, do C on the file to determine the mode, and -return the mode, formatted as above. - -=head2 Novice Operation Mode - -A common mistake when dealing with permission modes is to use C<644> -where you meant to use C<0644>. Every permission has a numeric -representation, but the representation only makes sense when you write -the number in octal. The decimal number 644 corresponds to a -permission setting, but not the one you think. If you write it in -octal you get 01204, which corresponds to the unlikely permissions -C<-w----r-T>, not to C. - -The appearance of the bizarre permission C<-w----r-T> in a program is -almost a sure sign that someone used C<644> when they meant to use -C<0644>. By default, this module will detect the use of such unlikely -permissions and issue a warning if you try to format them. To disable -these warnings, use - - Stat::lsMode->novice(0); # disable novice mode - - Stat::lsMode->novice(1); # enable novice mode again - -The surprising permissions that are diagnosed by this mode are: - - 111 => --xr-xrwx - 400 => rw--w---- - 440 => rw-rwx--- - 444 => rw-rwxr-- - 551 => ---r--rwt - 600 => --x-wx--T - 640 => -w------T - 644 => -w----r-T - 660 => -w--w-r-T - 664 => -w--wx--T - 666 => -w--wx-wT - 700 => -w-rwxr-T - 711 => -wx---rwt - 750 => -wxr-xrwT - 751 => -wxr-xrwt - 751 => -wxr-xrwt - 755 => -wxrw--wt - 770 => r------wT - 771 => r------wt - 775 => r-----rwt - 777 => r----x--t - -Of these, only 400 is remotely plausible. - -=head1 BUGS - -As far as I know, the precise definition of the mode bits is portable -between varieties of Unix. The module should, however, examine -C or use some other method to find out if there are any local -variations, because Unix being Unix, someone somewhere probably does -it differently. - -Maybe C should have an option that says that if the file -is a symlink, to format the mode of the pointed to file instead of the -mode of the link itself, the way C does. - -=head1 SEE ALSO - -=over 4 - -=item * - -C. - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=head1 AUTHOR - -Mark-Jason Dominus (C). - -=cut -