File Coverage

blib/lib/Stat/lsMode.pm

Criterion	Covered	Total	%
statement	25	48	52.0
branch	9	40	22.5
condition			n/a
subroutine	5	7	71.4
pod	2	4	50.0
total	41	99	41.4

#
#
# Stat::lsMode
#
# Copyright 1998 M-J. Dominus
# ([e-mail])
#
# You may distribute this module under the same terms as Perl itself.
#
# $Revision: 1.2 $ $Date: 1998/04/20 01:27:25 $


package Stat::lsMode;

$VERSION = '0.50';

use Carp;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(format_mode file_mode format_perms);

@perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
@ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?);
$ftype[0] = '';

$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
      $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, @_);
}




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 it 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