#!/usr/bin/perl -w

#
# RED v1.1 | Remove Empty Directories (and Files)
#
# The purpose of this perl script is to remove all empty sub-directories
# within a specific directory. It also removes empty files which have zero
# size. Limitations: This program cannot touch files and directories that
# have Unicode characters in the file name or path name!
#
# This script was developed using TinyPerl 5.8 running on
# Windows XP SP2, but it was tested on Linux and MacOS as well.
# Written by Zsolt N. Perry (zsnp@juno.com) in June 2023, Pensacola, FL.
#
# I RELEASE THIS PROGRAM INTO PUBLIC DOMAIN. If you want to incorporate it
# or parts of it into your program, just copy and paste whatever you need!
# There is no need to ask for permission. This software is distributed
# "AS IS." There is no warranty of any kind. The author will not be held
# liable for any loss resulting from the use or misuse of this software!
#
####################################################################

use strict;
use warnings;
$| = 1;

my $PATH = "C:\\TEMP";

my $REMOVE_EMPTY_DIRS  = 1;
my $REMOVE_EMPTY_FILES = 1;


print
  "\n\nRED v1.1 | Remove Empty Directories (and Files)",
  "\nWritten by Zsolt N. Perry (zsnp\@juno.com)\n\nScanning $PATH\n";
DeleteEmptyDir($PATH);
exit;

##################################################
#
# This function reads the contents of a directory
# and removes this directory if it's empty.
# In order for the empty directory to be removed
# the second argument must be 1. And then this
# function will return 1 if the directory is gone.
# Returns zero otherwise.
#
# Usage: INTEGER = DeleteEmptyDir(PATH, [REMOVE])
#
sub DeleteEmptyDir
{
  my $PATH = defined $_[0] ? $_[0] : '';
  my $DELETE = defined $_[1] ? $_[1] : 0;  # Delete $PATH if empty?
  length($PATH) or return;

  $PATH =~ s/^\s*\"//;  # Remove initial double quote
  $PATH =~ s/\"\s*$//;  # Remove final double quote
  $PATH =~ tr'\\'/';    # Change all backslash to forward slash

  # Check if path contains any illegal characters
  if ($PATH =~ m/[*?<>\|\0\r\n]+/)
  { print "\n* Illegal char: $PATH"; return; }

  # Make sure that PATH ends with a forward slash
  $PATH .= '/';         # Add a forward slash to the end
  $PATH =~ tr|/||s;     # Remove duplicate forward slashes

  my $PATHONLY = substr($PATH, 0, length($PATH) - 1);
  unless (-e $PATHONLY)
  { print "\n* Doesn't exist: $PATHONLY"; return; }
  unless (-d $PATHONLY)
  { print "\n* Not a directory: $PATHONLY"; return; }

  local *DIR;
  my $FILES = 0;
  unless (opendir(DIR, $PATH))
  { print "\n* Cannot opendir: $PATHONLY"; return; }
  while ((my $NAME = readdir(DIR)))
  {
    if ($NAME eq '.' || $NAME eq '..') { next; }
    my $FULLNAME = "$PATH$NAME";
    if (-d $FULLNAME)
    {
      DeleteEmptyDir($FULLNAME, $REMOVE_EMPTY_DIRS);
      # If this dir still exists, then it wasn't empty.
      -e $FULLNAME or next;
    }
    if ($REMOVE_EMPTY_FILES)
    {
      if (-f $FULLNAME && -z $FULLNAME)  # Empty file?
      {
        if (DeleteFile($FULLNAME, 1))
        {
          print "\n* File deleted: $FULLNAME";
          next;
        }
        print "\n* Can't delete empty file: $FULLNAME";
      }
    }
    $FILES++;   # Count remaining files and sub-directories.
  }
  closedir(DIR);
  if ($DELETE && $FILES == 0)  # Delete empty dir?
  {
    rmdir $PATHONLY;                   # Delete this dir.
    if (-e $PATHONLY && -d $PATHONLY)  # Check if it's gone.
    { print "\n* Can't delete dir: $PATHONLY"; return 0; }
    else
    { print "\n* Dir deleted: $PATHONLY"; return 1; }
  }
  return 0;
}
##################################################
#                                 File | v2023.6.7
# This function deletes a single file. It will not
# delete directories! Note: The file name and file path
# must NOT contain any Unicode characters or any
# special characters such as * ? | < > \r \n \0
# Returns 1 if the file is gone, or 0 if it still exists.
#
# Usage: INTEGER = DeleteFile(FILENAME, [FORCE])
#
sub DeleteFile
{
  my $F = defined $_[0] ? $_[0] : '';
  my $FORCE = defined $_[1] ? $_[1] : 0;

  $F =~ s/^\s*\"//;        # Remove initial double quote
  $F =~ s/\"\s*$//;        # Remove final double quote
  length($F) or return 1;  # Make sure file name is not empty.

  -e $F or return 1;   # File not found?
  -f $F or return 0;   # Make sure it's a file.

  # Check if file name contains any illegal characters
  if ($F =~ m/[*?<>\|\0\r\n]+/) { return 0; }

  unlink($F);          # Delete file.
  -e $F or return 1;   # File is gone?

  if ($FORCE)          # Force delete?
  {
    if ($^O =~ m/DOS|MSWIN|CYGWIN/i)
    {
      $F =~ tr'/'\\';  # Change all forward slash to backslash
      $F =~ tr'\\''s;  # Remove duplicate backslashes
      system("ATTRIB \"$F\" -S -H -R +A");
    }
    else { chmod 0777, $F; }
  }
  unlink($F);               # Try to delete it again.
  return (-e $F) ? 0 : 1;   # Still exists?
}
##################################################
#                                 File | v2023.6.6
# This function returns zero if a directory exists
# and has files or sub-directories in it.
# Returns 1 in every other case.
# Usage: INTEGER = IsDirEmpty(PATH)
#
sub IsDirEmpty
{
  my $PATH = defined $_[0] ? $_[0] : '';
  -e $PATH or return 1;
  -d $PATH or return 1;
  local *DIR;
  opendir(DIR, $PATH) or return 1;
  while ((my $NAME = readdir(DIR)))
  {
    ($NAME eq '.' || $NAME eq '..') or return 0;
  }
  closedir(DIR);
  return 1;
}
##################################################