#!/usr/bin/perl -w
#
# Removes an empty folder $1, *without* prompting the user.
#
# Case 1: $1 is an empty folder (simple case) -- delete it.
#
# Case 2: $1 is not empty, but none of its contents or sub-contents
# are files (only other empty folders) -- delete it.
#
# Case 3: $1 is not empty, and contains at least 1 file (or some folder
# containing a file at some level) -- open the folder.
#
# 100829 John C. Norton -- created.
# 111230 John C. Norton -- finally got installation working!
##
###############
## Libraries ##
###############
use strict;
use warnings;
use File::Basename;
use File::Copy;
use IO::File;
use Win32::TieRegistry( Delimiter => '/' );
##################
## User-defined ##
##################
my $b_debug = 0;
my $label = '* Remove Folder(s)';
#############
## Globals ##
#############
my $iam = basename $0;
my $syntax = qq{
syntax: $iam /install
or: $iam /uninstall
Installs the $iam program into the specified directory and
creates a right-click context menu entry "$label" to remove
a selected folder if it is empty as well as any empty subfolders. If a
top-level folder is not empty, it is opened in Explorer so the user can
see its contents.
With the argument '/uninstall', the program is removed from the context
menu instead.
};
##################
## Main Program ##
##################
my $dir = shift or die $syntax;
if ($dir eq '/uninstall') {
my $h_shell = context_menu_uninstall();
print "Uninstalled \"$label\"\n";
exit;
}
if ($dir eq '/install') {
my $location = shift or die "$iam: must specify installation dir\n";
(my $path = $location) =~ s|\\|/|g;
copy("$0", $path);
context_menu_install($location);
print "Installed '$iam' as \"$label\"\n";
exit;
}
# Quit if argument is not a dir (shouldn't get here though)
(-d $dir) or exit;
if (remove_subfolders($dir)) {
# Top folder is empty, so just remove it
rmdir $dir;
} else {
# Top folder is not empty; open it
(chdir "$dir") or exit; # Can't change to directory
exec "start .";
}
#################
## Subroutines ##
#################
sub context_menu_uninstall {
my $h_shell = $Registry->{"Classes/Directory/shell"};
my $key = "$label/";
delete_key($h_shell, $key);
return $h_shell;
}
sub context_menu_install {
my ($target) = @_;
# Remove previous version (if any)
my $h_shell = context_menu_uninstall();
my $key = "$label/";
# Create new context menu
$b_debug and print "[Adding Key '$key']\n";
my $fullcmd = qq{cmd.exe /C $target\\$iam "%1"};
$h_shell->{$key} = { "command/" => { "/" => $fullcmd } };
}
sub delete_key {
my ($h_keys, $key) = @_;
if ($key =~ m|/$|) {
my $h_subkey = $h_keys->{$key};
if (ref $h_subkey) {
map { delete_key($h_subkey, $_) } keys %$h_subkey;
}
$b_debug and print "[Deleting Key '$key']\n";
delete $h_keys->{$key};
} else {
$b_debug and print "[Deleting Data '$key']\n";
delete $h_keys->{$key};
}
}
#
# Inputs: $1: a folder name
# Outputs: Nonzero if all subfolders of the given folder were removed,
# (ie. no files were found at any level), zero otherwise.
#
sub remove_subfolders {
my ($dir) = @_;
my $b_empty = 1;
my @empty = ( );
my $fh = new IO::File;
opendir($fh, $dir) or exit;
my @files = readdir($fh);
closedir $fh;
foreach my $file (@files) {
next if ($file eq '.' or $file eq '..');
my $path = "$dir/$file";
if (!-d $path) {
# Not a folder; parent folder is not empty
$b_empty = 0;
} else {
# It's a folder
if (!remove_subfolders($path)) {
$b_empty = 0;
} else {
push @empty, $path;
}
}
}
# Remove all empty subfolders
foreach my $path (@empty) {
(rmdir $path) or $b_empty = 0;
}
return $b_empty;
}