#
# This script does directory listing for the XNJS writing
# the results on stdout in the format that the XNJS expects.
#
# The XNJS config file contains the full path to where
# the tsi_ls script is stored.
#
# This script expects two arguments.
#
# The first argument of the script indicates if the listing
# should be of just the file (argument is A), recursive (argument is R) or non-recursive (argument
# is any other value).
#
# The second argument is the root file of the listing.
#
# The format of the output is as follows:
#
#   Listing starts with the line:
#
#   START_LISTING
#
#   and ends with the line:
#
#   END_LISTING
#
#   The files are listed in depth-first order. Each time a sub-directory
#   is found the entry for the sub-directory file is listed and then entries
#   for all the file in the subdirectory are listed.
#
#   The format for each listing line is:
#
#      Character 0 is usually blank, except:
#
#            If character 0 is '-', then the this line contains extra
#            information about the file described in the previous line.
#              If the next character is 2nd '-' then this line provides an extended
#              information about file (see below). Otherwise this line is copied
#              without change into the ListDirectory outcome entry for the file.
#
#            If character 0 is '<', then all files in a sub-directory
#            have been listed and the listing is continuing with the parent
#            directory. This is required even when the listing is non-recursive.
#
#     Character 1 is 'D' if the file is a directory
#
#     Character 2 is "R" if the file is readable by the Xlogin (effective uid/gid)
#
#     Character 3 is "W" if the file is writable by the Xlogin (effective uid/gid)
#
#     Character 4 is "X" if the file is executable by the Xlogin (effective uid/gid)
#
#     Character 5 is "O" if the file is owned by the Xlogin (effective uid/gid)
#
#     Character 6 is a space.
#
#     Until the next space is a decimal integer which is the size of the file in bytes.
#
#     Until the next space is a decimal integer which is the last modification
#     time of the file in seconds since the Unix epoch.
#
#     Until the end of line is the full path name of the file.
#
#
#     Extended permissions specification is encoded on the next line as follows:
#
#     --rwxrwxrwx owner owningGroup
#
#     where letters rwx can be replaced by '-' to form standard UNIX permissions,
#     'owner' is file owner uid and 'owningGroup' is file owning gid. After owning group
#     space is permitted and additional text may be present. Currently it will be ignored.
#
#     Every line is terminated by \n
#
#
#######################################################################################

use strict;

# >>>>>>>>>> Parse command line

my $type = shift;

if ( $type eq "A" ) {
    $main::as_file = 1;
}
elsif ( $type eq "R" ) {
    $main::recursive = 1;
}
else {
    $main::recursive = 0;
}

my $file_name = shift;

# Do the (limited) variable expansion allowed by the NJS

$file_name =~ s/\$USER/$ENV{USER}/g;
$file_name =~ s/\$HOME/$ENV{HOME}/g;

# >>>>>>>>>> Do listing

print "START_LISTING\n";

if ( -d $file_name ) {
    if ($main::as_file) {
        print_entry($file_name);
        print "<\n";    # mark the end of directory listing
    }
    else {
        list($file_name);
    }
}
else {
    print_entry($file_name);
}

print "END_LISTING\n";

#
#  Print the details of one file
#
#
sub print_entry {

    my $target = shift;

    if ( -e $target ) {

        use filetest 'access';

        my $is_dir   = " ";
        my $is_read  = " ";
        my $is_write = " ";
        my $is_exec  = " ";
        my $is_own   = " ";

        $is_dir   = "D" if -d $target;
        $is_read  = "R" if -r $target;
        $is_write = "W" if -w $target;
        $is_exec  = "X" if -x $target;
        $is_own   = "O" if -o $target;

        my (
            $device, $inode, $mode, $nlink, $uid,     $gid, $rdev,
            $size,   $atime, $modt, $ctime, $blksize, $blocks
        ) = stat $target;

        my $u_r = "-";
        my $u_w = "-";
        my $u_x = "-";
        my $g_r = "-";
        my $g_w = "-";
        my $g_x = "-";
        my $o_r = "-";
        my $o_w = "-";
        my $o_x = "-";

        $u_r = "r" if $mode & 0400;
        $u_w = "w" if $mode & 0200;
        $u_x = "x" if $mode & 0100;
        $g_r = "r" if $mode & 0040;
        $g_w = "w" if $mode & 0020;
        $g_x = "x" if $mode & 0010;
        $o_r = "r" if $mode & 0004;
        $o_w = "w" if $mode & 0002;
        $o_x = "x" if $mode & 0001;

        my $gid_name = getgrgid($gid);
        my $uid_name = getpwuid($uid);

        print " $is_dir$is_read$is_write$is_exec$is_own $size $modt $target\n";
        print "--$u_r$u_w$u_x$g_r$g_w$g_x$o_r$o_w$o_x $uid_name $gid_name\n";
    }
}

#
# List a directory
#
# Pre-conditions: target is a directory
#
sub list {

    my $target = shift;

    local *DIR;
    if ( opendir( DIR, $target ) ) {

        my $entry;
        while ( defined( $entry = readdir(DIR) ) ) {

            next if $entry =~ /^\.\.?$/;    # skip . and ..

            if ( -d "$target/$entry" ) {
                print_entry("$target/$entry");

                list("$target/$entry") if $main::recursive;

                # mark the end of directory listing
                print "<\n";
            }
            else {
                print_entry("$target/$entry");
            }

        }

        closedir(DIR);
    }
}

#
#                   Copyright (c) Fujitsu Ltd 2000 - 2004
#
#                Use and distribution is subject a License.
# A copy was supplied with the distribution (see documentation or the jar file).
#
# This product includes software developed by Fujitsu Limited (http://www.fujitsu.com).
