#!/usr/bin/perl -w

use strict;
use warnings;

#
# This Perl script prints all the files in the current
# directory and all subdirectories and saves the sorted
# list in OUTPUT.TXT.
#
##################################################

my $OS = GetOS();
my $BR = $OS < 3 ? "\r\n" : "\n";
my $PATH = GetCurrentDirectory();
my $OUTPUT = JoinPath( GetCurrentDirectory(), 'OUTPUT.TXT' );
my $RECURSIVE = 0;
my @ALLFILES;

About();
print '-' x 80;
print "Output file: $OUTPUT\n\n";

CheckDIR($PATH);
@ALLFILES = sort @ALLFILES;
print join($BR, @ALLFILES);
CreateFile($OUTPUT, join($BR, @ALLFILES)) or die "COULDN'T SAVE OUTPUT FILE - $OUTPUT\n";
print "SUCCESS.\n";
exit;

##################################################
#                                      v2019.11.28
# Returns the current working directory. (If a drive
# letter is specified, then it returns the current
# directory of that drive. This applies to DOS/Windows
# only where each drive has its own current directory.)
# Usage: STRING = GetCurrentDirectory([DRIVE])
# Example: GetCurrentDirectory('D:')  --> 'D:\WORK'
#
sub GetCurrentDirectory
{
  if ($OS < 3)
  {
    my $DRIVE = defined $_[0] ? substr($_[0], 0, 2) : '';
    return Trim(`CD $DRIVE`);
  }
  return Trim(exists($ENV{PWD}) ? $ENV{PWD} : `pwd`);
}
##################################################
#
# This function removes all whitespace from before
# and after text and returns a new string. This
# function removes every character whose ASCII
# value is less than 33. This includes tab, space,
# null, vertical tab, esc, new lines, etc..
#
# Usage: STRING = Trim(STRING)
#
sub Trim
{
  my $S = defined $_[0] ? $_[0] : '';
  my $L = length($S) or return '';
  my $START = 0;
  my $LAST = 0;
  while ($L--)
  {
    if (vec($S, $L, 8) > 32)
    {
      $START = $L;
      $LAST or $LAST = $L + 1;
    }
  }
  return substr($S, $START, $LAST - $START);
}
##################################################
#
# This function returns the OS type as a number.
# 1=DOS 2=WINDOWS 3=LINUX 4=OSX 9=OTHER
#
sub GetOS
{
  my $OS = uc($^O);
  index($OS, 'LINUX')  >= 0 ? 3 :
  index($OS, 'MSWIN')  >= 0 ? 2 :
  index($OS, 'DOS')    >= 0 ? 1 :
  index($OS, 'DARWIN') >= 0 ? 4 : 9;
}
##################################################
# Prints the description of this program.
# Usage: About()
#
sub About
{
  my $PTRSIZE = `$^X -V:ptrsize`;
  $PTRSIZE =~ s/[^0-9]//g;
  print "\nPerl $] ", ($PTRSIZE << 3), '-bit ', $^O, ', ' . localtime(), "\n";
  my $S = ReadFile($0);
  my $P = 1 + index($S, '# ');
  my $E = 1 + index($S, '###', $P);
  $E && $P or die "\nMissing argument.\n";
  $S = substr($S, $P, $E - $P);
  $S =~ tr/#//d;
  print "\n $0\n\n$S";
}
##################################################
#
# This function reads the entire contents of a file
# in binary mode and returns it as a string. If an
# errors occur, an empty string is returned silently.
# A second argument will move the file pointer before
# reading. And a third argument limits the number
# of bytes to read.
# Usage: STRING = ReadFile(FILENAME, [START, [LENGTH]])
#
sub ReadFile
{
  my $NAME = defined $_[0] ? $_[0] : '';
  $NAME =~ tr/\"\0*?|<>//d;	# Remove special characters
  -e $NAME or return '';
  -f $NAME or return '';
  my $SIZE = -s $NAME;
  $SIZE or return '';
  my $LEN = defined $_[2] ? $_[2] : $SIZE;
  $LEN > 0 or return '';
  local *FH;
  sysopen(FH, $NAME, 0) or return '';
  binmode FH;
  my $POS = defined $_[1] ? $_[1] : 0;
  $POS < $SIZE or return '';
  $POS < 1 or sysseek(FH, 0, $POS);	# Move file ptr
  my $DATA = '';
  sysread(FH, $DATA, $LEN);		# Read file
  close FH;
  return $DATA;
}
##################################################
#                                       v2019.7.13
# This function joins two names into a single path by
# adding / in between the names. It also simplifies the
# resulting path by removing repeated \\ // characters,
# and tries to resolve the "." and ".." in a path name
# to literal names only.
# Usage: STRING = JoinPath(STRING, [STRING], [STRING]])
#
sub JoinPath
{
  my @A;
  foreach my $S (@_)   # Harvest arguments
  {
    defined $S or next;
    length($S) or next;
    push(@A, $S);
  }

  if ($OS < 3)      # Change / into \ on DOS/Win systems
  { foreach my $S (@A) { $S =~ tr#/#\\#; } }

  @A or return '';
  my $P = Trim(shift(@A));	# Extract first element
  my $L = length($P);

  # Remove prefix
  if (uc(substr($P, 0, 8)) eq 'FILE:///')
  { $P = substr($P, 8); }

  # Detect drive letter / start point on DOS/Win
  my $DRIVE = '';
  my $BACKSLASH = '';
  my $SEPARATOR = '/';
  if ($OS < 3)
  {
    if (vec($P, 1, 8) == 58)
    {
      $DRIVE = substr($P, 0, 2);
      $P = substr($P, 2, $L);
    }
    if (vec($P, 0, 8) == 92)
    {
      $BACKSLASH = '\\';
      $P = substr($P, 1, $L);
    }
    $SEPARATOR = '\\';
  }
  unshift(@A, $P);	# Put it back

  # Split along each separator
  @A = split("\\$SEPARATOR", join($SEPARATOR, @A));

  # Process each section of path
  my $TRIM = $OS > 2 ? '/' : '/\\';
  for (my $i = 0; $i < @A; $i++)
  {
    # Remove leading and trailing slashes
    $A[$i] = TrimChar($A[$i], $TRIM);

    # Remove "." or zero-length string
    if ($A[$i] eq '.' || length($A[$i]) == 0)
    { splice(@A, $i--, 1); next; }

    # Resolve ".."
    if ($A[$i] eq '..')
    {
      if ($i > 0)
      { splice(@A, --$i, 2); $i--; }
      else
      { splice(@A, $i, 1); $i--; }
    }
  }
  return $DRIVE . $BACKSLASH . join($SEPARATOR, @A);
}
##################################################
#                                       v2019.6.15
# Just like Trim(), this function can remove spaces
# or tabs from before and after STRING but it can also
# remove any other character, whatever is found in SUBSTR.
# Usage: STRING = TrimChar(STRING, SUBSTR)
#
sub TrimChar
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L or return '';
  defined $_[1] or return $_[0];
  length($_[1]) or return $_[0];
  my $START = 0;
  my $LAST = 0;
  while ($L--)
  {
    if (index($_[1], substr($_[0], $L, 1)) < 0)
    {
      $START = $L;
      $LAST or $LAST = $L + 1;
    }
  }
  return substr($_[0], $START, $LAST - $START);
}
##################################################
#
# This function reads the contents of a folder and
# calls CatchFile() for each file that was found.
# Usage: CheckDIR(PATH)
#
sub CheckDIR
{
  my $PATH = defined $_[0] ? $_[0] : '';
  length($PATH) or return;

  # Change / to \ on Windows and DOS computers
  if ($OS < 3) { $PATH =~ tr#/#\\#; }

  # Make sure that PATH ends with a backslash or forward slash
  if (index("/\\", substr($PATH, length($PATH)-1, 1)) < 0)
  { $PATH .= ($OS < 3 ? "\\" : '/'); }

  my $EXT;
  my @SUBDIRS;
  my $FULLNAME;
  local *DIR;
  opendir(DIR, $PATH) or return;
  while ((my $NAME = readdir(DIR)))
  {
    if (length($NAME) < 3)
    { $NAME ne '.' && $NAME ne '..' or next; }

    $FULLNAME = "$PATH$NAME";

    # We will display directories first, followed by
    # symbolic links, then all other special files,
    # and plain files last.
       if (-f($FULLNAME)) { $NAME = -s $FULLNAME; while (length($NAME) < 12) { $NAME = "0$NAME"; } }
    elsif (-d($FULLNAME)) { $NAME = ('-' x 12); push(@SUBDIRS, $FULLNAME); }
    elsif (-l($FULLNAME)) { $NAME = ('.' x 12); }
    else                  { $NAME = ('=' x 12); }
    push(@ALLFILES, $NAME . ' ' . $FULLNAME);
  }
  closedir(DIR);
  $RECURSIVE or return;
  foreach $PATH (@SUBDIRS) { CheckDIR($PATH); }
}
##################################################
#                                      v2019.11.24
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
# Usage: INTEGER = CreateFile(FILE_NAME, CONTENT)
#
sub CreateFile
{
  defined $_[0] or return 0;
  my $F = $_[0];
  $F =~ tr/\"\0*?|<>//d;	# Remove special characters
  length($F) or return 0;
  local *FH;
  open(FH, ">$F") or return 0;
  binmode FH;
  if (defined $_[1] ? length($_[1]) : 0) { print FH $_[1]; }
  close FH or return 0;
  return 1;
}
##################################################