Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Find files older than x days and delete them

by OzzyOsbourne (Chaplain)
on Aug 22, 2000 at 00:42 UTC ( #28912=perlcraft: print w/replies, xml ) Need Help??

   1: # Deletes all files older than the number if days input
   2: # Written by Jonathan E. Dyer 4/18/00
   3: # Server varibale is hard coded and named $dir1, b/c this script can be dangerous
   4: 
   5: # *********************************
   6: # Call Modules
   7: # *********************************
   8: 
   9: use File::Find;
  10: use File::Copy;
  11: use Getopt::Std;
  12: getopts('d:h');
  13: 
  14: # *********************************
  15: # Initialize variables
  16: # *********************************
  17: 
  18: $server='server1';
  19: $dir1='\\\\'."$server".'\\e$\\clients';
  20: $out="c:/$server.txt";
  21: $agedays=60; #defaults agedays to 60
  22: 
  23: # *********************************
  24: # Process arguments ([h]elp,[d]ays)
  25: # *********************************
  26: 
  27: if ($opt_h){
  28: 	die "\agecmd.pl -d[days to age]\n";
  29: }
  30: 
  31: if ($opt_d){
  32: 	if ($opt_d gt 9){ #tests for strings
  33: 		die "Error: days option must be a number.  Use agecmd.pl -d[days to age]\n";
  34: 	}else{
  35: 	$agedays=$opt_d;
  36: 	}
  37: }
  38: 
  39: # *********************************
  40: # Do date calculations
  41: # *********************************
  42: 
  43: @xtime=localtime(time);
  44: $day=$xtime[3]+1;
  45: $month=$xtime[4]+1;
  46: $year=$xtime[5]+1900;
  47: $hours=$xtime[2];
  48: $mins=$xtime[1];
  49: $secs=$xtime[0];
  50: $logname='//mfa3e04/e$/'."ftp$month$day$year$hours$mins$secs".'.log';
  51: 
  52: $agesecs=60*60*24*$agedays;	#converts $agedays to seconds
  53: $daysago=time-$agesecs;		#the time stamp of $agedays ago in seconds
  54: $daysago2=localtime($daysago);	#the time stamp of $agedays ago in words - mainly for printing
  55: 
  56: 
  57: # *********************************
  58: # Find the files (no dir) on the server
  59: # *********************************
  60: 
  61: print "finding files to be aged\.\.\.\n";
  62: find(\&wanted, $dir1);
  63: 
  64: sub wanted {
  65: 	$filesecs = (stat("$File::Find::dir/$_"))[9]; #GETS THE 9TH ELEMENT OF file STAT - THE MODIFIED TIME
  66: 	$filesecs2=localtime($filesecs);
  67: 	if ($filesecs<$daysago && -f){ #-f=regular files, eliminates DIR p.367 
  68: 		push (@files,"$File::Find::dir/$_");
  69: 		push (@files,"$filesecs2");
  70: 	}
  71: 	print'.';
  72: }
  73: 
  74: # *********************************
  75: # replace '/' with '\' in file names
  76: # *********************************
  77: 
  78: foreach (@files){
  79: 	s/\//\\/g;
  80: }
  81: 
  82: # *********************************
  83: # Write to Log
  84: # *********************************
  85: 
  86: %filehash=@files; #puts the array into a hash for easy printing.  Key=file, Value=date
  87: open OUT, ">$logname" or die "Cannot open $out for write :$!";
  88: print OUT "FTP server aging log generated by PERL script\n";
  89: print OUT "Script written by Jonathan E. Dyer on 4/18/00\n";
  90: print OUT "Files deleted from \\\\$server on ".localtime(time)."\n";
  91: print OUT "Files deleted before $daysago2\n";
  92: print OUT "Files were aged $agedays days\n\n";
  93: print OUT "File Listing:\n\n";
  94: foreach $filename (sort keys %filehash){
  95: 	print OUT "$filename	$filehash{$filename}\n";
  96: }
  97: close OUT;
  98: #!/usr/bin/perl -w
  99: 
 100: # *********************************
 101: # Delete files
 102: # *********************************
 103: 
 104: print "\nDeleting all files before $daysago2";
 105: unlink %filehash;
 106: print "\nScript complete.";

Replies are listed 'Best First'.
RE (tilly) 1: Find files older than x days and delete them
by tilly (Archbishop) on Aug 22, 2000 at 00:52 UTC
    Here is a script I have used for a similar task in one directory. I have changed the name of the directory for obvious reasons:
    #! /usr/local/bin/perl die unless chdir "/some/hardcoded/dir/here"; die unless opendir DIR, "."; foreach $file (grep {-f && (14 < -M)} readdir DIR) { unlink $file; } closedir DIR;
    Amusing note. I wrote this after accidentally crashing someone else's ftp server by throwing the accumulated contents of a large dir at it. The next day I went and made every change I could think of that would have prevented the disaster. Running this script daily was one of those changes. :-)

    EDIT
    Hmmm...this was one of my earlier scripts. Definitely before I learned the value of informative error messages. And written in a hurry...but I think I should leave it anyways as an example to show that my coding style has matured...

        I know this is plain, flat heresy, especially here inside the monastry, but why use perl for this at all?
        find /your/path -mtime numberofdays -exec rm -f {} \;
        Father, forgive me, for I have sinned ... ;-))

        Andreas

        Update:

        Once again I am humbly admitting that merlyn and tilly made good points (see below). So now we have three chief reasons (weapons) for a perl solution:

        After this confession, shall I be free? Hey, stick away from that comfy chair ...
        (do you know that feeling when you should do your already late travel and time reports for your company but keep lurking around instead? Oh boy ...)
RE: Find files older than x days and delete them
by OzzyOsbourne (Chaplain) on Aug 24, 2000 at 01:04 UTC

    this was an early version of this script. When you go through a giant server, and the script fails, you are left cold and bitter. It now writes directly to the file.

    The only reason that I originally did it this way was I thought that doing one big write would be faster than several small writes.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://28912]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2023-02-07 17:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (40 votes). Check out past polls.

    Notices?