Beefy Boxes and Bandwidth Generously Provided by pair Networks RobOMonk
Just another Perl shrine
 
PerlMonks  

Prune Empty Win32 (Sub)Folders

by liverpole (Monsignor)
on Dec 31, 2011 at 03:04 UTC ( #945711=CUFP: print w/ replies, xml ) Need Help??

One of my (many) annoyances with Windows happens when deleting a folder. First of all, if it's empty, shouldn't Windows be smart enough to figure that out, and say "Really remove the Empty folder 'junk'?" rather than "Are you sure you want to remove the folder 'junk' and move all its contents to the Recycle Bin?" (italics mine). So many times, I've gone back and opened the folder again, just to be sure that it really was empty. What a waste of time.

But really, even besides that, shouldn't there be an option to just quietly delete empty folders? After all, folder creation is a very inexpensive operation. You don't see the corresponding command in Linux "rmdir" being so conservative with empty directories.

Here's a script I wrote about a year ago but didn't quite get the installation part working. Today I figured out how to install it correctly -- if you run it with the "/install <dir>" switch, it copies the program to a directory of your choice, and then installs itself as a context menu item, so you can right-click on any folder and it does one of two things:

  1. If the folder is empty, it simply deletes the folder.
  2. If the folder is not empty, it opens the folder (in Explorer, not as a file) so you can see its contents.

Furthermore, any empty subfolders are also deleted, even if other subfolders or files exist in the top-level folder.

I find I use this a lot, because it's a safe way to prune stuff from my Windows machine at work, as well as my laptop. If it saves just a little aggravation each time you use it, that can add up to a lot of saved frustration over time...

#!/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 fol +der # 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 <dir> or: $iam /uninstall Installs the $iam program into the specified directory <dir> 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 use +r can see its contents. With the argument '/uninstall', the program is removed from the co +ntext 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 remove +d, # (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; }

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Comment on Prune Empty Win32 (Sub)Folders
Download Code
Re: Prune Empty Win32 (Sub)Folders
by GrandFather (Cardinal) on Dec 31, 2011 at 05:41 UTC

    Sorta removes the need for a Perl script which is a bit of a bummer, but from the Windows command prompt rmdir works rather like rmdir at a *nix command prompt.

    True laziness is hard work

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://945711]
Approved by zwon
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (10)
As of 2014-04-16 11:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (424 votes), past polls