Cleaning up by age

brianarn has asked for the wisdom of the Perl Monks concerning the following question:

Got a question that I'm having some difficulty finding - it's probably something I've missed somewhere, but I'm still essentially a newbie to Perl, so be gentle. ;)

I'm writing up a script that allows for my group to archive our shift status at the end of each shift. My manager insists on just archiving an M$ Word doc instead of letting me write up something more dynamic (which I've done before using server-parsed TCL).

My script accepts the file properly (using CGI.pm), will even warn if you are uploading a shift status that is already there and will represent the upload script but with an 'Override' field that wasn't there (set to No by default, but can be put to Yes to upload). However, I don't have direct access to the server so I can't go in and clean out files occasionally myself, and these status files can be anywhere from 100-200k, so they can fill up a directory after a month.

I'm trying to write up a function that'll go through the directory handed to it and remove the 10 oldest files when called - I've tried -M and -A both, but all files return the same age. I've included some small debug statements for my own purpose, will present here.

sub clean_dir {
    my $dir = shift;
    my %age;
    my $debug = 1;

    # Loop through files and add ages into array
    opendir (DIR, $dir) or die "Unable to open $dir: $!";
    while (readdir (DIR)) {
        my $temp_age = -M "$dir/$_";
        if ($debug) {
            print "Age checked in readdir loop: $temp_age<BR>\n";
            print "File checked in readdir loop: $_<BR>\n";
        }
        $age{$temp_age} = $_;
    }
    # DEBUG
    if ($debug) {
        print "Ages:<BR>\n";
        print "$_: $age{$0}<BR>\n" foreach sort keys %age;
        print "Oldest files...<BR>\n";
    }
    foreach (sort ({keys (%age)}[0..9])) {
        print "$_[0]<BR>\n" if ($debug);
        # Commented out removes to be safe for now
        #system("rm", "$dir/$age{$_[0]}")
        #    or die "Can't remove $dir/$age{$_[0]}: $!";
        print "$_[0] removed." if ($debug);
    }
}
[download]

I know that if nothing else, I could just do something like:

my @files = split /\n/, `ls -rtl $dir`;
system ("rm","$dir/$_") for @files[0..9];
[download]

but that seems a little cheap - is there a better way to do this?

~Brian

Comment on Cleaning up by age Select or Download Code

Replies are listed 'Best First'.
Re: Cleaning up by age by Jazz (Curate) on Nov 13, 2001 at 00:31 UTC
Here's an easy way to glob, sort, and propagate an array with the 10 oldest files in a directory... `my $debug = 1; my @oldest_10_files = ( map { $_->[1] } sort { $b->[0] <=> $a->[0] } map { [ -M $_, $_ ] } glob( "/path/to/directory/" ) )[0..9]; unlink @oldest_10_files unless $debug; print "The following files have been removed\n\n", join "\n", @oldest_ +10_files;` [download] Hope this helps. Update*: The above code utilizes the Schwartzian Transform. Thanks, Jonathan for pointing out the oversight.	[reply] [d/l]
Re: Re: Cleaning up by age by Jonathan (Curate) on Nov 15, 2001 at 18:21 UTC
If you are going to use a Schwartzian Transform please give credit where due.	[reply]
Re(3): Cleaning up by age by FoxtrotUniform (Prior) on Nov 20, 2001 at 22:21 UTC
If you are going to use a Schwartzian Transform please give credit where due. Eh? The ST's an idiom, not some sort of proprietary construct. It's not as if there's some great dispute over whose leap of hackerly brilliance it was -- the credit is right in the name! When someone sees `map/sort/map` they'll immediately think "Oh, a Schwartzian Transform". Immediate credit to Merlyn. That said, pointing out that a ST was used is probably a Good Thing -- that way, a novice (or maintenance programmer :-) confronted with the code has some recourse beyond "what the hell's up with all these `map`s?" The ST is pointed out, so the unfamiliar reader can go off and read up on STs... and learn something in the process. `-- :wq`	[reply]
Re: Cleaning up by age by Albannach (Monsignor) on Nov 13, 2001 at 00:54 UTC
To the cause of your specific problem, the line: `while (readdir (DIR)) {` does not magically assign to `$_`, so for a quick fix you could change it to `while ($_ = readdir (DIR)) {` You'll be much closer to what you want. I guess you never saw any of your debug messages that indicated that no files were ever tested in your loop. ;-) -- I'd like to be able to assign to an luser	[reply] [d/l] [select]
Re: Re: Cleaning up by age by brianarn (Chaplain) on Nov 13, 2001 at 01:24 UTC
Y'know, now that I think about it, you're right - I should have snapped. Arg. heh. Thanks. :) Now let's see if I can get this all cleaned up. :)	[reply]
Re: Cleaning up by age by Rich36 (Chaplain) on Nov 13, 2001 at 00:47 UTC
Instead of using "rm", you can use unlink - which does take array references. `unlink(@files[0..9]);` [download] That could be used in conjunction with File::Find like so... #!/usr/bin/perl -w use strict; use File::Find; my %age = (); my $dir = $shift; find(\&getFileAge, $dir); # Sort the values of %age my @files = sort {$a <=> $b} keys %age; # Remove the files foreach (@files[0..9]) {print qq($age{$_} $_\n);} # DEBUG - prints val +ues unlink @files[0..9] \|\| warn "Couldn't remove $_\n"; # Removes files sub getFileAge() { # This gives you the full path of the file without # having to append the dir name my $element = $File::Find::name; if (-f $element) { my $temp_age = -M $element; $age{$temp_age} = $element; } } [download] Rich36 There's more than one way to screw it up...	[reply] [d/l] [select]


Perl: the Markov chain saw
	PerlMonks