[EMAIL PROTECTED] wrote: > Hello, > > I was wondering if anyone has a script that > will remove empty directories and subdirectories. > The code that I am using will delete the entries > at the first sublevel but not at multiple sublevels. > [snip]
John --
Maybe you've got a solution already. I tinkered with it a bit and below is what I came up with. I tested it, and it seems to work... though I'm sure the code is redundant, not just recursive. ;-)
-- mike higgins
- - - - - - - - - - - - - 8< - - - - - - - - - - - -
use strict;
my $dir = 'd:/test';
my $do = 0;
my @deepest; map_deepest($dir,[EMAIL PROTECTED]); #find deepest folders
my %delete; my %keep;
foreach my $deepdir (@deepest){ # get empty folders
get_empties($deepdir,\%delete, $dir, \%keep);#
}foreach (keys %keep){
delete $delete{$_} if (exists $delete{$_}); # cause we have to
}my %tree; # to delete in rising order
foreach ( keys %delete ){
my @t = split /\//,$_;
push @{$tree{scalar @t}}, $_;
}foreach my $key (sort {$b<=>$a} keys %tree){
foreach ( @{$tree{$key}} ){
if ($do){
if ( rmdir ($_) ){
print "deleted: $_\n";
}
else { print "rmdir $_ failed\n" }
}
else { print "would delete: $_\n";
}
}
}################## SUBS ################
sub get_empties{
my $dir = shift;
my $deleteref = shift;
my $basedir = shift;
my $keep = shift or {};my $updir = substr ($dir, 0, rindex ($dir, '/'));
if (exists $$keep{$dir} ){
$$keep{$updir}++; delete ($$deleteref{$updir});
get_empties($updir,$deleteref,$basedir,$keep)
unless ($updir eq $basedir);
} else{
opendir DIR, $dir or die $!, $dir;
my @files = grep !-d, map {"$dir/$_"}(readdir DIR);
closedir DIR; if (! ( scalar @files ) ){
$$deleteref{$dir}++ unless (exists $$keep{$dir} );
get_empties($updir,$deleteref,$basedir,$keep)
unless ($updir eq $basedir)
} else{
$$keep{$updir}++; delete ($$deleteref{$updir});
get_empties($updir,$deleteref,$basedir,$keep)
unless ($updir eq $basedir);
}
}
}sub map_deepest{
my $dir = shift;
my $retref = shift; local *DIR;
opendir DIR, $dir or warn $!, $dir ; if (my @dirs = (grep -d, map{"$dir/$_"}
grep !/^\.{1,2}$/, (readdir DIR))){ foreach my $dir ( @dirs ){
if (! ( map_deepest ($dir,$retref) ) ){push @$retref, $dir;}
}
return 1;
}
return 0;
}_______________________________________________ Perl-Win32-Admin mailing list [EMAIL PROTECTED] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
