Efficient symlink removal script

Hello Perlers,

Anyone can supply me with a script that checks a directory hierarchy full of symlinks and delete those that have last modified (done by touch) date older than X hours? This is gonna be a cron job, and the server is kind of high of cpu and i/o load, so the removal process should be maximally stressless.

500 points who gives me ready script.

directory hierarchy is as follows:

/base/a.b.c.d/232323.zip
/base/a.b.c.d/232324.zip
/base/a.b.e.f/345323.zip
/base/a.b.c.d/e.f.g.h/434323.zip
/base/a.b.c.d/e.z.x.y/655653.zip

a.b.c.d - random ip addresses, a.b.c.d/e.z.x.y - for users behind proxies. :)
all zips are symlinks to zips located somewhere else.

LVL 1
Vahan YerkanianVirtualization Architect, DevOpsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Dave CrossModule AuthorCommented:
Are you checking for the age of the symlink or the file that it links to? If it's the actual file use "stat" as shown below, if it 's the symlink replace it with "lstat". This code is untested, but I'm sure it's pretty close :)

use File::Find;

my $now = time;
my $hours = 10; # how old a file gets before it is deleted
my $age = $hours * 60 * 60; # $hours in seconds

my $dir = '/base'; # where to start from

find(\&wanted, $dir);

sub wanted {
  next unless -l; # only handle symlinks

  my $file_age = (stat )[8];

   unlink if $file_age < $now - $age);
}


hth,

Dave...
Vahan YerkanianVirtualization Architect, DevOpsAuthor Commented:
i need to check the age of the symlink...

make your code tested, and get your 500 points =)
Vahan YerkanianVirtualization Architect, DevOpsAuthor Commented:
I also need to have a list of symliks deleted printed...
Expert Spotlight: Joe Anderson (DatabaseMX)

We’ve posted a new Expert Spotlight!  Joe Anderson (DatabaseMX) has been on Experts Exchange since 2006. Learn more about this database architect, guitar aficionado, and Microsoft MVP.

Dave CrossModule AuthorCommented:
Now tested :)

#!/usr/bin/perl
                                                                               
use strict;
use warnings;
                                                                               
use File::Find;
                                                                               
my $now = time;
my $hours = 10; # how old a file gets before it is deleted
my $age = $hours * 60 * 60; # $hours in seconds
                                                                               
my $dir = '/base'; # where to start from
                                                                               
find(\&wanted, $dir);
                                                                               
sub wanted {
 return unless -l; # only handle symlinks
                                                                               
 my $file_age = (lstat)[8];
                                                                               
  if ($file_age < $now - $age) {
    print "Deleting old file: $_ (", scalar localtime $file_age, ")\n";
    unlink;
  } else {
    print "Not deleting new: $_ (", scalar localtime $file_age, ")\n";
  }
}

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Vahan YerkanianVirtualization Architect, DevOpsAuthor Commented:
great.

if you add the following functionality, you'll get 600 points instead of 500.

I also need to delete subdirectories up to the $dir if the file deleted was the last one in the particular subdir

in other words, if /base/a/c contains only aa.zip and it's outdated, delete the file, rmdir /base/a/c, if there are no more files/directories in /base/a, delete /base/a

Dave CrossModule AuthorCommented:
Tell you what. Give me the 500 points for what I've done so far and post added functionality as a new question for 100 points.
Vahan YerkanianVirtualization Architect, DevOpsAuthor Commented:
davorg,

You need to believe people more...

this is the new question: http://www.experts-exchange.com/Programming/Programming_Languages/Perl/Q_20725618.html
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Perl

From novice to tech pro — start learning today.