Deleting Old Files

| No Comments
Here is a script that deletes old files.  In the Unix environment this is an easy job for a one line script using find.  This Perl version has the -test option, to allow you to see what will happen, and prints some totals.

#!/usr/bin/perl # delold.pl - delete old files #----------------------------------------------------------- # 05/24/2009 WR Written #----------------------------------------------------------- use strict; use warnings; use Win32::Autoglob; use Getopt::Long; $| = 1; sub print_usage; sub abort_usage; # option defaults my $days_back = 10; my $test_flag = 0; my $verbose_flag = 0; my $quiet_flag = 0; # get options GetOptions ( 'days=i' => \$days_back, 'test' => \$test_flag, 'verbose' => \$verbose_flag, 'quiet' => \$quiet_flag, 'usage' => sub {print_usage; exit 1}, ) or abort_usage "Invalid option"; my $time = time(); my $files_to_delete = 0; my $files_total = 0; my $files_failed = 0; FILE: for my $file (@ARGV) { # must exist, must be a plain old file next FILE if !-e $file; next FILE if !-f $file; $files_total++; # modified age in days my ($mtime) = (stat($file))[9]; my $modified_age = ($time - $mtime) / (3600 * 24); # skip if too young next FILE if $modified_age < $days_back; $files_to_delete++; if ($test_flag || $verbose_flag) { printf "Age: %-6.1f File: %s\n", $modified_age, $file; } # skip if we are testing next FILE if $test_flag; # delete the file if (!unlink $file) { warn "Failed to delete file $file\n"; $files_failed++; } } if ($test_flag) { print "\nTest Flag is set, no deletes done!\n"; } my $files_remaining = $files_total - $files_to_delete + $files_failed; if (!$quiet_flag || $test_flag) { print "\n"; print "Total files: $files_total\n"; print "Files to delete: $files_to_delete\n"; print "Failed to delete: $files_failed\n"; print "Files remaining: $files_remaining\n"; } exit 1; sub abort_usage { print STDERR join("\n", @_), "\n" if @_; print_usage; exit 0; } sub print_usage { print STDERR <<END; Usage: delold.pl [Options] files... Options: --days n - Set age of files to keep. Files over "days" old will be deleted. Default is 10 days. --test - Print file names to be deleted with age, but do not actually delete. Default is false. --verbose - Print file name and age while deleting. Default is false. --quiet - Suppress printing of totals after deleting. Default is false. --usage - print this message and exit END }

Leave a comment

About this Entry

This page contains a single entry by Bill Ruppert published on May 24, 2009 9:51 AM.

Promoting Perl was the previous entry in this blog.

"Everything" at VoidTools.com is the next entry in this blog.

Find recent content on the main index or look in the archives to find all content.

Pages

OpenID accepted here Learn more about OpenID
Powered by Movable Type 4.38