You are here iC Home > Perl > Perl for Sysad's > Delete old files (cleanup.pl)

Perl

6.8 Delete old files (cleanup.pl)

11.05.2008
6.7 LDAP [  up  ] - [ a - z ] - [ search PC ] - [ top ] 6.9 Delete accident files

Download → files/cleanup pl.txt
#!/usr/bin/perl -w
use strict;

# -- /usr/local/bin/cleanup.pl @ primus PG
# -- Wed Sep  7 14:24:13 CEST 2005
my $VERSION = '0.82.02';

$| = 1;

die "Age in days! --> cleanup 60 pre <-- prefix\n" unless $ARGV[0];
die "Prefix! --> cleanup 60 pre\n" unless $ARGV[1];

my $NEWEST = $ARGV[2] || '' eq 'newest' ? 1 : 0;
my $msg = $NEWEST ? 'newer than' : 'older than';

print "Deleting files $msg $ARGV[0] days with prefix $ARGV[1]!...\n";
sleep(3);

opendir(D, ".") or die $!;

my $time = time();

while (my $f = readdir(D)) {
	next if $f =~ /^\./;
	next unless $f =~ /^$ARGV[1]/;

	my ($atime, $mtime, $ctime) = (stat($f))[8..10];
	my $age_hours = ($time - $mtime) / 3600;
	my $age_days  = int($age_hours / 24);

	next if $f =~ /^cleanup/;
	if ($NEWEST) {
		next unless $age_days < $ARGV[0];
	}
	else {
		next unless $age_days > $ARGV[0];
	}
	
	print "---> Deleting $f ($age_days days)...";
	unlink $f;
	print " done\n";
}

closedir(D);


Tip: Save as /usr/local/bin/cleanup.pl


Advanced search tips
6.7 LDAP [  up  ] - [ top ] 6.9 Delete accident files



[ home ] - [ search ] - [ feedback ]

copyright by reto - created with mytexi