r2692 - in /packages/libstat-lsmode-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/t/ tags/
rra at users.alioth.debian.org
rra at users.alioth.debian.org
Sun May 7 20:01:11 UTC 2006
Author: rra
Date: Sun May 7 20:01:10 2006
New Revision: 2692
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2692
Log:
[svn-inject] Installing original source of libstat-lsmode-perl
Added:
packages/libstat-lsmode-perl/
packages/libstat-lsmode-perl/branches/
packages/libstat-lsmode-perl/branches/upstream/
packages/libstat-lsmode-perl/branches/upstream/current/
packages/libstat-lsmode-perl/branches/upstream/current/MANIFEST
packages/libstat-lsmode-perl/branches/upstream/current/Makefile.PL
packages/libstat-lsmode-perl/branches/upstream/current/README
packages/libstat-lsmode-perl/branches/upstream/current/lsMode.pm
packages/libstat-lsmode-perl/branches/upstream/current/t/
packages/libstat-lsmode-perl/branches/upstream/current/t/t.t
packages/libstat-lsmode-perl/tags/
Added: packages/libstat-lsmode-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libstat-lsmode-perl/branches/upstream/current/MANIFEST?rev=2692&op=file
==============================================================================
--- packages/libstat-lsmode-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libstat-lsmode-perl/branches/upstream/current/MANIFEST Sun May 7 20:01:10 2006
@@ -1,0 +1,5 @@
+README
+MANIFEST
+lsMode.pm
+Makefile.PL
+t/t.t
Added: packages/libstat-lsmode-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libstat-lsmode-perl/branches/upstream/current/Makefile.PL?rev=2692&op=file
==============================================================================
--- packages/libstat-lsmode-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libstat-lsmode-perl/branches/upstream/current/Makefile.PL Sun May 7 20:01:10 2006
@@ -1,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Stat::lsMode',
+ 'VERSION_FROM' => 'lsMode.pm', # finds $VERSION
+# 'LIBS' => [''], # e.g., '-lm'
+# 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+# 'INC' => '', # e.g., '-I/usr/include/other'
+ 'dist' => {COMPRESS => 'gzip', SUFFIX => 'gz'},
+);
Added: packages/libstat-lsmode-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libstat-lsmode-perl/branches/upstream/current/README?rev=2692&op=file
==============================================================================
--- packages/libstat-lsmode-perl/branches/upstream/current/README (added)
+++ packages/libstat-lsmode-perl/branches/upstream/current/README Sun May 7 20:01:10 2006
@@ -1,0 +1,12 @@
+
+This module is for formatting file modes and permissions the way that
+ls -l does. For example, if you have a file that is world-readable,
+but only writable by its owner, you can use
+
+ file_mode($file)
+
+which will return the string '-rw-r--r--'.
+
+Beta version 0.50.
+
+20 April 1998. M-J. Dominus (mjd-perl-lsmode at plover.com)
Added: packages/libstat-lsmode-perl/branches/upstream/current/lsMode.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libstat-lsmode-perl/branches/upstream/current/lsMode.pm?rev=2692&op=file
==============================================================================
--- packages/libstat-lsmode-perl/branches/upstream/current/lsMode.pm (added)
+++ packages/libstat-lsmode-perl/branches/upstream/current/lsMode.pm Sun May 7 20:01:10 2006
@@ -1,0 +1,253 @@
+#
+#
+# Stat::lsMode
+#
+# Copyright 1998 M-J. Dominus
+# (mjd-perl-lsmode at plover.com)
+#
+# 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;
+ at ISA = qw(Exporter);
+ at EXPORT = qw(format_mode file_mode format_perms);
+
+ at perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
+ at 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.
+
+ at 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<ls -l> 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<Stat::lsMode> generates mode and permission strings that look like
+the ones generated by the Unix C<ls -l> 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<Stat::lsMode> 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<stat> call.
+
+=head2 C<format_mode>
+
+Given a mode number (such as the third element of the list returned by
+C<stat>), return the appopriate ten-character mode string as it would
+have been generated by C<ls -l>. 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<format_mode> will return the string
+C<drwxr-xr-x>.
+
+If C<format_mode> 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<format_mode(0755)> will
+return just C<rwxr-xr-x>, without the leading C<d>.
+
+=head2 C<file_mode>
+
+Given a filename, do C<lstat> 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<rw-r--r-->.
+
+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<stat.h> 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<file_mode> 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<ls -Ll> does.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+C<http://www.plover.com/~mjd/perl/lsMode/>.
+
+=item *
+
+L<ls>
+
+=item *
+
+L<chmod>
+
+=item *
+
+L<stat>
+
+=back
+
+=head1 AUTHOR
+
+Mark-Jason Dominus (C<mjd-perl-lsmode at plover.com>).
+
+=cut
+
Added: packages/libstat-lsmode-perl/branches/upstream/current/t/t.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libstat-lsmode-perl/branches/upstream/current/t/t.t?rev=2692&op=file
==============================================================================
--- packages/libstat-lsmode-perl/branches/upstream/current/t/t.t (added)
+++ packages/libstat-lsmode-perl/branches/upstream/current/t/t.t Sun May 7 20:01:10 2006
@@ -1,0 +1,66 @@
+#!/usr/bin/perl
+
+use lib '../lib/blib';
+use Stat::lsMode qw(format_mode file_mode);
+
+print "1..14\n";
+
+foreach $i (0 .. 7) {
+ my $t = $i * 73;
+ my $mode = format_mode(oct("0$i$i$i"));
+ $mode =~ s/^\?//;
+ $mode =~ tr/-/0/;
+ $mode =~ tr/0/1/c;
+ my $total = 0;
+ foreach $bit (split //, $mode) {
+ $total = $total * 2 + $bit;
+ }
+ if ($total/73 != $i) {
+ print "not ok ", $i+1, "\n";
+ } else {
+ print "ok ", $i+1, "\n";
+ }
+}
+
+umask 000;
+$dir = "/tmp/SlsM.$$." . time;
+
+if (mkdir $dir, 0700) {
+ print (((file_mode($dir) eq 'drwx------') ? '' : 'not '), "ok 9\n");
+} else {
+ print "not ok 9\n";
+}
+
+
+if (open F, "> $dir/file") {
+ print (((file_mode("$dir/file") eq '-rw-rw-rw-') ? '' : 'not '), "ok 10\n");
+} else {
+ print "not ok 10\n";
+}
+
+umask 022;
+if (open F, "> $dir/file2") {
+ print (((file_mode("$dir/file2") eq '-rw-r--r--') ? '' : 'not '), "ok 11\n");
+} else {
+ print "not ok 11\n";
+}
+
+if (symlink "$dir/file2", "$dir/link") {
+ print (((file_mode("$dir/link") =~ /^l/) ? '' : 'not '), "ok 12\n");
+} else {
+ print "not ok 12\n";
+}
+
+# Test with a umask
+if (mkdir "$dir/dir", 0236) {
+ print (((file_mode("$dir/dir") eq 'd-w---xr--') ? '' : 'not '), "ok 13\n");
+} else {
+ print "not ok 13\n";
+}
+
+umask 0;
+if (mkdir "$dir/dir2", 0236) {
+ print (((file_mode("$dir/dir2") eq 'd-w--wxrw-') ? '' : 'not '), "ok 14\n");
+} else {
+ print "not ok 14\n";
+}
More information about the Pkg-perl-cvs-commits
mailing list