#! /usr/bin/perl -wl
#################################################################
# listfiles
# Enhanced version of "listfile" script featured on pp. 217-218
# of "Minimal Perl for UNIX and Linux People", by Tim Maher.
# Adds error-checking, symbolic-link handling, and listing of
# (non-hidden) files of current directory by default.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
#  Author: Tim Maher, tim@TeachMePerl.com
# Version: Wed Nov 15 10:11:38 PST 2006
#################################################################
# NOTE: Listings are printed in ARGV order (if supplied), or else in
#       globbing's ASCII-betical order.
use strict;
{ # Scope for MAIN
    my @listings;
    # Doesn't handle ls's -a, etc., so discard hyphen-prefixed
    # options, if any. NOTE: This means filenames can't start with
    # a hyphen (which would be unconventional anyway).
    # strip leading -whatever arguments
    while ( defined $ARGV[0] and $ARGV[0] =~ /^-/ ) {
        warn "$0: Ignoring option: '$ARGV[0]'\n";
        shift;
    }
    if (@ARGV) {
        @listings=list_files ( @ARGV );
    }
    else {
        @listings=list_files ( <*> ); 
    }
    { local $,="\n";
      print @listings; # print each listing on separate line
    }
} # End of scope for MAIN
sub list_files {
    # load CPAN module whose format_mode() function
    # converts 0644 --> "-rw-r--r--"
    use Stat::lsMode;
    my @lines; # each element will be a listing of one file
    foreach my $filename ( @_ ) {
        my ($mode, $nlink, $uid, $gid, $size, $mtime, 
            $rwx_mode, $uid_name, $gid_name, $time, $target );
        if (! -l $filename) { # not a symlink
            # test for existence; "_" is shortcut for $filename
            -e _  or  warn "$0: '$filename'; $!\n" and next;
            (undef, undef, $mode, $nlink, $uid, $gid,
                undef, $size, undef, $mtime)=stat _;
        }
        else { # for symlinks use "lstat"
            (undef, undef, $mode, $nlink, $uid, $gid,
                undef, $size, undef, $mtime)=lstat $filename;
            $target=readlink $filename; # see what it points to
            if (! defined $target) {
                $target='[No Target!]';
                warn "$0: Can't read target for '$filename'; $!\n";
            }
        }
        # convert seconds to time string
        $time=localtime $mtime;
        # convert UID-number to string
        $uid_name=$uid; # keep numeric ID if can't convert to user-name
        my $x=getpwuid $uid;
        defined $x and $x =~ /\D/ and $uid_name=$x;
        # convert GID-number to string
        $gid_name=$gid; # keep numeric ID if can't convert to user-name
        $x=getgrgid $gid;
        defined $x and $x =~ /\D/ and $gid_name=$x;
        $rwx_mode=format_mode $mode;  # octal mode --> rwx format
        my $listing=sprintf "%s %2d %-6s %-6s %6d %s %s",
            $rwx_mode, $nlink, $uid_name,
                $gid_name, $size, $time, $filename;
        $target and $listing.=" -> $target";
        push @lines, $listing;
    }
    return @lines;
}