May 2009 Archives

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 # - 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: [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 }

Promoting Perl

| No Comments
The Perl community is making an effort to improve visibility.  I added "Perl programming" to the top of the blog in support of this effort.

About this Archive

This page is an archive of entries from May 2009 listed from newest to oldest.

April 2009 is the previous archive.

June 2009 is the next archive.

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


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