perlfile-find

perl File::Find - delete files with certain conditions, then delete parent folder if empty


I am attempting to use File::Find to 1) go thru a given folder and subfolders, deleting any files that are older than 30 days, and b) if the parent folder is empty after all the deletions, also delete it.

Here is my code:

use strict;
use warnings;
no warnings 'uninitialized';
use File::Find;
use File::Basename;
use File::Spec::Functions;

# excluding some home brew imports


# go into given folder, delete anything older than 30 days, and if folder is then empty,     delete it

my $testdir = 'C:/jason/temp/test';
$testdir =~ s#\\#/#g;

open(LOG, ">c:/jason/temp/delete.log");

finddepth({ wanted => \&myWanted, postprocess => \&cleanupDir }, $testdir);

sub myWanted {

   if ($_ !~ m/\.pdf$/i &&
       int(-M $_) > 30
      ) 
   {
      my $age = int(-M $_);
      my $path = $File::Find::name;
      print LOG "age : $age days - $path\n";
      unlink($path);

   }
}


sub cleanupDir {
   my $path = $File::Find::dir;
   if ( &folderIsEmpty($path) ) {
      print LOG "deleting : $path\n";
      unlink($path);
   } else {
      print LOG "$path not empty\n";
      my @files = glob("$path/*");
      foreach my $file(@files){
         print LOG "\t$file\n";
      }
   }

}

I had thought that finddepth() would go to the bottom of the tree and work its way up, but that didn't happen. The script, run on an unzip of some ebook contents, did not delete directories that had subfolders, even though all the files were deleted.

age : 54 days - C:/jason/temp/test/mimetype
age : 54 days - C:/jason/temp/test/META-INF/container.xml
age : 54 days - C:/jason/temp/test/META-INF/ncx.xml.kindle
deleting : C:/jason/temp/test/META-INF
age : 54 days - C:/jason/temp/test/OEBPS/content.opf
age : 54 days - C:/jason/temp/test/OEBPS/cover.html
age : 54 days - C:/jason/temp/test/OEBPS/ncx.xml
age : 54 days - C:/jason/temp/test/OEBPS/pagemap.xml
age : 54 days - C:/jason/temp/test/OEBPS/t01_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t02_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t03_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t04_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t05_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t06_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t07_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_01_text.html
age : 54 days - C:/jason/temp/test/OEBPS/media/cover.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/flamlogo.gif
age : 54 days - C:/jason/temp/test/OEBPS/media/logolnmb.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/stylesheet.css
deleting : C:/jason/temp/test/OEBPS/media
C:/jason/temp/test/OEBPS not empty
    C:/jason/temp/test/OEBPS/media
C:/jason/temp/test not empty
    C:/jason/temp/test/META-INF
    C:/jason/temp/test/OEBPS

looks like the C:/jason/temp/test/OEBPS/media/ was deleted, but that deletion was not registered by the time the preprocess func was called. Any ideas as to how to get this to work? thanks!

thanks, bp


Solution

  • As Miller has commented, you can't unlink a directory. Also, File::Find does a chdir into a node's containing directory before it calls wanted. That means that, in the postprocess subroutine, you are trying to remove your currently working directory. Windows won't like that.

    I would write it like this. I have tested it, but you should obviously be very careful with anything that deletes the contents of your disk storage.

    use strict;
    use warnings;
    use autodie;
    
    use File::Find;
    use File::Spec::Functions;
    
    my $testdir = 'C:\jason\temp\test';
    
    open my $log, '>', 'C:\jason\temp\delete.log';
    
    finddepth(\&wanted, $testdir);
    
    sub wanted {
    
      my $full_name = canonpath $File::Find::name;
    
      if (-f) {
        my $age  = int(-M);
        unless ( /\.pdf\z/ or $age <= 30) {
          print $log "Age: $age days - $full_name\n";
          unlink;
        }
      }
      elsif (-d) {
        my @contents = do {
          opendir my ($dh), $_;
          grep { not /\A\.\.?\z/ } readdir $dh;
        };
        rmdir unless @contents;
      }
    }