John W. Krahn wrote:
> Khairul Azmi wrote:
>>On 6/23/06, John Ackley <[EMAIL PROTECTED]> wrote:
>>>Khairul Azmi wrote:
>>>>I have this problem. There is a script that stores log files into
>>>>folders that follows structure of the following
>>>>
>>>>YYYY/MM/DD
>>>>
>>>>eg..
>>>>
>>>>/var/log/projects/2006/06/20/8231.tgz
>>>>/var/log/project1/2006/06/21/1432.tgz
>>>>/var/log/projects/2006/06/22/1756.tgz
>>>>/var/log/projects/2006/06/23/1756.tgz
>>>>
>>>>Now I want to write a script that would erase all logs that has been
>>>>stored except for the log for the current day. For the above example,
>>>>since today is 23 June 2006, the code will erase log files in
>>>>folders 2006/06/20/ and 2006/06/21/ only. Can somebody give ideas on
>>>>how to do this. This script is to be ran once a day.
>>>#! /usr/bin/perl
>>>use strict;
>>>use warnings;
>>>use Date::Manip;
>>>
>>>my $directory;
>>>my $days = 2;
>>>while( -d
>>> ($directory =
>>> UnixDate(DateCalc('today',"$days ago"),
>>> '/var/log/projects/%Y/%m/%d')) ) {
>>> unlink "$directory/*";
>>> $days++;
>>>}
>>Thanks for the code. However it does not works as expected. My testing
>>shows that the program will only unlink folders if the structure name
>>of the folders falls exactly on the range.
>>
>>Say today is 16 August 2006. If I have only have this folder
>>
>>/var/log/project1/2006/08/08/8231.tgz
>>
>>The program does not works, unless I change the variable $days exactly
>>to 8. What I need is a program that could unlink all folders except
>>for today's.
>
> use File::Basename;
> use POSIX 'strftime';
>
> my $root = '/var/log/projects';
>
> my $today = strftime '%Y/%m/%d', localtime;
>
> my @files = grep !m!^$root/$today!,
> glob "$root/[0-9][0-9][0-9][0-9]/[0-9][0-9]/[0-9][0-9]/*.tgz";
>
> for my $file ( @files ) {
> unlink $file or warn "Cannot unlink '$file' $!";
> for ( 1 .. 3 ) {
> my $dir = dirname $file;
> rmdir $dir; # ignore errors!
$file = $dir;
> }
> }
John
--
use Perl;
program
fulfillment
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
