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

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]
[reply]

        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 maps?" 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]
      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]

Back to Seekers of Perl Wisdom