#!/usr/bin/perl -w
#
# $Id: rwxconv,v 2.11 2003/08/01 02:10:57 jmates Exp $
#
# The author disclaims all copyrights and releases this script into the
# public domain.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use Getopt::Std;  # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 2.11 $ ') =~ s/[^0-9.]//g;

my (%opts, $zero, $lzero);

######################################################################
#
# MAIN

# parse command-line options
getopts('h?0', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

# mangle all input
while (<>) {
  $lzero = 0;

  # handle annoying suid bits
  if (
    s/([d-]?[r-][w-])([Ssx-])([r-][w-])([Ssx-])([r-][w-])([Ttx-])/
        $1.unsuid($2).$3.unsuid($4).$5.unsuid($6)/ex
   ) {
    $lzero += 4 if $2 and $2 =~ /[Ss]/;
    $lzero += 2 if $4 and $4 =~ /[Ss]/;
    $lzero += 1 if $6 and $6 =~ /[Tt]/;
  }

  undef $lzero if $lzero == 0 and not exists $opts{'0'};

  $^W = 0;  # hide uninit warnings on $lzero

  s/[d-]?([r-][w-][x-])([r-][w-][x-])([r-][w-][x-])/
        $lzero.r2m($1).r2m($2).r2m($3)/ex;

  print;
}

exit;

######################################################################
#
# SUBROUTINES

# converts rwx blocks into octal equivalent
sub r2m {
  my $str = shift;

  $str =~ tr/\-a-z/01/;  # make it a binary number

  # convert from binary into an octal digit
  return oct unpack "N", pack "B32", substr "0" x 32 . $str, -32;
}

# changes suid strings (s's and t't) into x or - as appropriate
sub unsuid {
  my $char = shift;
  $char =~ tr/sStT/x-x-/;
  return $char;
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [opts] [file1 .. fileN]

Converts rwx-style permission listings into octal format.

Options for version $VERSION:
  -h/-?  Display this message

  -0     Include leading 0 in output, if required.

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

rwxconv - converts rwx-style permission listings into octal format.

=head1 SYNOPSIS

To filter the output of a long directory listing:

  $ ls -al | rwxconv

=head1 DESCRIPTION

=head2 Overview

This script accepts input, searches for -rwxr-xr-x style elements, and
converts said strings into octal format, e.g. 0755.

Generally, this script will be used to feed data into other programs
that operate on octal mode data, where the input is only available in
the rwx-form.

=head2 Normal Usage

  $ rwxconv [options] [file1 .. fileN]

This script will read from STDIN if no files are mentioned on the
command line.

Output will be done to STDOUT.

See L<"OPTIONS"> for details on the command line switches supported.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-0>

Includes a leading 0 to mode output, if required.  Default is to print
modes like 644; this option would change that to 0644.

=back

=head1 EXAMPLES

Anywhere rwx-style output is produced, this script can convert:

  $ tar tvf foo.tar | rwxconv

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

File::Mode, perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

The author disclaims all copyrights and releases this script into the
public domain.

=head1 HISTORY

Based heavily on code found in the File::Mode module on CPAN by Idan
Robbins.

=head1 VERSION

  $Id: rwxconv,v 2.11 2003/08/01 02:10:57 jmates Exp $

=head1 SCRIPT CATEGORIES

UNIX/System_administration

=cut