#!/usr/bin/perl -w

my $rcsid  = '$Id: pathinfo,v 1.2 2006/03/07 19:32:41 vogelke Exp $';

=head1 NAME

 pathinfo

=head1 SYNOPSIS

 pathinfo [-hsv] [files]

=head1 DESCRIPTION

 Read files from stdin, or on the command line.
 Print modtime, permissions, and optional hash of each file.
 Filenames are printed using URI-escape characters in case they
 include spaces or other foolishness.

=head1 OPTIONS

 -h        prints help and exits.
 -s        include SHA1 hash of regular files.
 -v        prints the version and exits.

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Sumaria Systems, Inc.

=cut

use strict;
use subs qw/gid2name printinfo uid2name usage version/;
use Getopt::Std;
use File::Basename;
use Fcntl ':mode';
use Carp;
use Digest::SHA1 qw/sha1_hex/;
use IO::File;
use URI::Escape;

#
# Handle arguments.
#

my ($myname) = basename($0, ".pl");

my %opts;
getopts('hsv', \%opts) or usage();

if ($opts{v}) {
    warn version(), "\n";
    exit(0);
}

if ($opts{h}) {
    usage();
}

if (interactive()) {
    usage("Need some files.");
}

#
# Stat each file.  Handle arguments intelligently.
#

if (@ARGV) {
    foreach (@ARGV) {
        printinfo($_, $opts{s});
    }
}
else {
    while (<>) {
        chomp;
        printinfo($_, $opts{s});
    }
}

exit(0);

#---------------------------------------------------------------------
# Print a line for each file.

sub printinfo {
    my ($path, $sig) = @_;
    my ($digest, $fh, $safepath, $mode, $uid, $gid, $size, $mtime);
    my ($user, $group);

    if (($mode, $uid, $gid, $size, $mtime) = (stat($path))[2,4,5,7,9]) {
        $mode   = sprintf("%lo", S_IMODE($mode));
        $digest = '-';

        if ($sig && -f $path) {
            $fh = new IO::File $path, "r";
            if (defined $fh) {
                binmode($fh);
                $digest = Digest::SHA1->new->addfile($fh)->hexdigest;
                $fh->close;
            }
        }

        $safepath = uri_escape($path, " \x00-\x1f\x7f-\xff");
	$user = uid2name($uid);
	$group = gid2name($gid);
        print "$safepath $mode $user $group $size $mtime $digest\n";
    }
    else {
        warn "$path: stat: $!\n";
    }
}

#---------------------------------------------------------------------
# Cache for user and groupnames.

my %gid2name;
my %uid2name;

sub gid2name {
    if ($gid2name{$_[0]}) {
        $gid2name{$_[0]};
    }
    else {
        $gid2name{$_[0]} = scalar getgrgid($_[0]);
    }
}

sub uid2name {
    if ($uid2name{$_[0]}) {
        $uid2name{$_[0]};
    }
    else {
        $uid2name{$_[0]} = scalar getpwuid($_[0]);
    }
}

#---------------------------------------------------------------------
# Test for STDIN being something other than a TTY.
# Taken from "Perl Best Practices", p219.  There's a CPAN module
# to do this, but Scalar::Util comes standard with perl.

sub interactive {
    use Scalar::Util qw(openhandle);

    # Not interactive if output is not to terminal...
    return 0 if not -t *STDOUT;

    # If *ARGV is opened, we're interactive if...
    if (openhandle * ARGV) {

        # ...it's currently opened to the magic '-' file
        return -t *STDIN if $ARGV eq '-';

        # ...it's at end-of-file and the next file is the
        # magic '-' file
        return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;

        # ...it's directly attached to the terminal
        return -t *ARGV;
    }

    # If *ARGV isn't opened, it will be interactive if *STDIN is
    # attached to a terminal and either there are no files specified
    # on the command line or if there are one or more files and the
    # first is the magic '-' file.
    return -t *STDIN && (@ARGV == 0 || $ARGV[0] eq '-');
}

#---------------------------------------------------------------------
# Print a usage message from the comment header and exit.

sub usage {
    my ($emsg) = @_;

    require Pod::Text;
    import Pod::Text;

    my $formatter = 'Pod::Text';
    my $parser    = $formatter->new();

    warn "$myname: $emsg\n\n" if $emsg;
    $parser->parse_from_file($0);
    exit(1);
}

#---------------------------------------------------------------------
# Return the current version.

sub version {
    return sprintf("%s  v%d.%02d  %s %s",
        $rcsid =~ /(\S+),v (\d+)\.(\d+) (\S+) (\S+)/);
}