Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Oldest file using -M

by Gerard (Pilgrim)
on Apr 27, 2004 at 05:18 UTC ( #348400=perlquestion: print w/replies, xml ) Need Help??

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

Greetings fellow monks

I am trying to find the oldest file in a directory, am running win 2000, apache 1.3. I have the following sub.
sub get_oldest_file { my $path = shift; # name of directory to search opendir( D, $path ) or return "Unable to read directory $path\n"; my $oldest_age = 0; my $oldest_name = ''; for ( readdir( D )) { next unless ( -f "$path/$_"); my $age = ( -M _ ); # note the "_" : uses stat data loaded by +"-f" above if ( $age > $oldest_age ) { $oldest_name = $_; $oldest_age = $age; } } closedir D; return $oldest_name; }
Which I gleamed from another post here at the monastery. When running this a lot of times in quick succession with files being created and removed in between (but not at the same time), about one time in 10 this will break, not returning any value (when there are definitely files in the directory). Perplexed I have changed the line my $oldest_age = 0; to my $oldest_age = -1; Thinking that possibly the $age could be = 0 when there is only one file....This seems to have helped a lot, reducing the number of "breaks" down to about 1 in 100, but there are still multiple files in the directory. (In my tests, 5 and 8).

It is possible that the calling code is broken, but I can't see anything obvious. Here is that sub in case that helps
sub GetMessage { my $filename; my $timeout = $q->param('Timeout'); # default timeout period is 10 seconds if ($timeout eq ""){ $timeout = 10; } $branch = $q->param('Branch'); my $dir = $baseDir . "\\" . $branch . "\\"; # first check to see if the directory exists if(! -e $dir){ &error("Requested branch at " . $dir . " does not exist"); } chdir($dir) ; eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm $timeout; # This process may take a while. If it does not complete withi +n $timeout seconds # it will be stopped. $filename=get_oldest_file("."); alarm 0; }; if ($@ eq "alarm\n") { # TIMED OUT - Was unable to calculate the oldest file in the g +iven # timeout period. Return not found print $q->header('text/html','404 Not Found - operation timed +out'); exit (0); } else { # Found the oldest file ok. Continue processing. my $size; $size = -s $filename || error("Unable to check file size " . $ +dir . $filename . " : " . $!); my $messageID = $filename; print $q->header(-Type=>'application/octet-stream', -Message_ID=>$messageID, -Content_Length=>$size); open(MSG,"< $filename") || error("Unable to open file " . $dir + . $filename . " for read: " . $!); binmode MSG; while(<MSG>) { print $_; } close MSG; } }
This now runs most of the time, but not all the time... It dies when trying to check the file size, as $filename doesn't contain anything.

Any ideas on what I am doing wrong, and what exactly -M file contains. To be honest I was surprised that changing it to -1 helped, but I changed it back to 0 just to check, and sure enough the problem occured a lot more frequently. Help?

Thanks, Gerard

Replies are listed 'Best First'.
•Re: Oldest file using -M
by merlyn (Sage) on Apr 27, 2004 at 05:23 UTC
    If all files in the directory are newer than the beginning of the script execution, you'll get no results. That's why you shouldn't initialize your "oldest" to 0, but rather to the first element of the array, if any:
    my @names = glob "*" or die "Nothing to scan"; my $oldest_name = shift @names; my $oldest_age = -M $oldest_name; for (@names) { # remaining names if (-M > $oldest_age) { $oldest_name = $_; $oldest_age = -M _; } } printf "%s is %.2d days old\n", $oldest_name, $oldest_age;
    Why does this look familar? Why, it's one of our Llama exercises!

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

      Ok, well that clears things up a great deal. Makes sense too. Just going to give it a test now....Thanks all for your replies.

      Regards, Gerard

      Update: Tested - Perfect! Thanks
Re: Oldest file using -M
by ehdonhon (Curate) on Apr 27, 2004 at 14:18 UTC

    The thing with -M is that it measures the age of the files, in days since $^T, which is initially set by perl to the epoch time when your program started. When you are running in mod_perl, don't expect $^T to be anywhere near the the present time, because it will be set to the time when your apache child started up.

    If you want to make sure that -M always returns a positive value (for all files created in the past), you need to do something like this:

    $^T = time(); my $fileage = -M $filename;

    However, in your case, it looks like all you care about is finding the oldest file in a list of files. That can be achieved easy enough:

    my ($oldest_file) = sort { -M $b <=> -M $a } @filenames;

    Update: merlyn correctly pointed out that setting $^T does not guarantee a positive return value for -M when the datestamp on a file is set to some time in the future.

      If you want to make sure that -M always returns a positive value
      No, that's no guarantee. Using utime, I can set the modtime to any value I want, including far into the future. Or, I might have unpacked a file from a tar-archive from a system with a badly set system clock.

      So, you must always be prepared for a negative -M value. Always.

      -- Randal L. Schwartz, Perl hacker
      Be sure to read my standard disclaimer if this is a reply.

      Thanks for your comments ehdonhon, I decided not to go with the sort method as it shouldn't be as efficent as just checking the file size. Unfortunately effeciency is the key in this problem as there may be up to 50,000 files in a given directory.
      Thanks for your help, Gerard

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://348400]
Approved by EdwardG
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2021-03-08 01:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favorite kind of desktop background is:











    Results (123 votes). Check out past polls.

    Notices?