bin/purge_old_iotw.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 # removes all iotw images >= a certain age
   6
   7 # set how long to keep old images
   8 my $days                = 32;
   9 my $limit               = $days * 24 * 60 * 60;
  10
  11 # directory to search
  12 my $dir                 = "/soldb/website/sgn/html/img/feature/iotw";
  13
  14 # get list of all iotw images
  15 opendir(DIR, $dir);
  16 my @files = grep(/\.jpg$/, readdir(DIR));
  17 closedir(DIR);
  18
  19 foreach my $file (@files) {
  20         my $filetime = (stat($dir."/".$file))[9];
  21         my $expiry   = $filetime+$limit;
  22         if ($expiry<time) {
  23                 print "$file is old, and will be deleted.\n";
  24                 unlink "$dir/$file";
  25         }
  26 }