A couple of problems....

[djw]

Below is a script used for checking a directory and all sub directories for anything that is over 30 days old. If the item is found to be older than 30 days then it gets deleted (this is on a win32 system *choke* using Active Perl).

This is used on a temp directory that I need to clean out every once and a while. The code works but not to my satisfaction. I would like to be able to send all errors to an error.txt file. How do you send output of a 'warn' or 'die' to a file?

I am also having a problem with the program trying to delete the actual 'foo' directory. The last line of my log file says:

'Directory: . - has been deleted.'
And I get an error message on the console that says:
'Cannot delete directory: . (Permission denied) at clear_transfer.pl line 58.'

I tried to use the Cookbooks example of ignoring '.' in a directory match, but then the program ignored all the directories that were over 30 days (obviously because the program was in whatever subdirectory it was trying to delete and wouldn't because that would match '.').

Those are the two things bothering me at the moment. If you see something else, please don't hesitate to point it out.

Thanks,
djw

#!/usr/bin/perl -w
use strict;            # uuuuussseeee thiiiissss
use File::stat;         # need this for ctime (creation time using sec
+onds since epoch)
use File::Find qw(finddepth);     # need this for recursive directory

my($create_date, $current_date, $time_month, $month_old);
my($dir,$dirs,$logfile,$logfile2);


##############################
# good little purl h4x0r's   #
# define their variable's    #
##############################


$_ = *File::Find::name;
$month_old = 2592000;            # set this to seconds. 2592000 = 30 d
+ays
$current_date = time;            # gives current time since the epoch 
+in seconds
$dir = 'c:\temp\foo';        
$logfile = 'c:\temp\log.txt';        
$logfile2 = 'd:\temp\log_keep.txt';    


########################################
# The switch is flipped!               #
# using File:Find:finddepth            #
# to step through all subdirectories   #
# using my function to test and delete #
########################################

finddepth \&deletion, $dir;

#############################################
# in my sub I start with files then         #
# directories.  Each creation date is       #
# tested before the nested if statements    #
# are run so we can see if the data needs   #
# deletion or not (oder than 30 days).      #
# I also log all deletion and non deletion  #
# activity                                  #
#############################################

sub deletion {
    if (-f) {
        $create_date = stat($_)->ctime;
        if ($create_date < ($current_date - $month_old)) {
            unlink ($_) or warn "Cannot delete file: $_ ($!)";
            open(LOG, ">>$logfile") or warn "discarding logfile output
+\n";
            print LOG "FIle: $_ - has been deleted.\n";
            close (LOG) or warn "Can't close: $!";
        } else {
            open(LOG, ">>$logfile2") or warn "discarding logfile outpu
+t\n";
            print LOG "The file $_ is newer than 30 days.\n";
            close(LOG) or warn "Can't close: $!";
        }
    } else {
        $create_date = stat($_)->ctime;
        if ($create_date < ($current_date - $month_old)) {
            rmdir ($_) or warn "Cannot delete directory: $_ ($!)";
            open(LOG, ">>$logfile") or warn "discarding logfile output
+\n";
            print LOG "Directory: $_ - has been deleted.\n";
            close (LOG) or warn "Can't close: $!";
        } else {
            open(LOG, ">>$logfile2") or warn "discarding logfile outpu
+t\n";
            print LOG "The dir $_ is newer than 30 days.\n";
            close(LOG) or warn "Can't close: $!";
        }
    }
}

[chromatic]

If you've ever used exception handling in another language, it's not too unfamiliar in Perl. You can use eval to catch an exception thrown with die:

# code to open ERRLOG here
eval {
    die "There's no way around this!";
};

if ($@) {
    print ERRLOG "Caught: $@!\n";
}

As for the directory deletion and warning, your code will always log a successful deletion, even if it fails. Try this:

if (rmdir ($_)) {
    open(LOG, ">>$logfile") or warn "discarding logfile output\n";
    print LOG "Directory: $_ - has been deleted.\n";
    close (LOG) or warn "Can't close: $!";
} else {
    warn "Cannot delete directory: $_ ($!)";
}

[djw]

I like it.

Thank you very much. I'll have to ++ you tomorrow.

Thanks,
djw

[knight]

I am also having a problem with the program trying to delete the actual 'foo' directory.

Is there any chance you're in the directory while trying to run the script? Unlike UNIX, Win32 won't allow a directory to be deleted when someone has cd'ed to the directory. I never get used to this...

[djw]

No I run the script from my desktop. Must be because windows catches the dir as 'in use' and won't unlock it until the script is completed. Which probably saves my entire hard drive from being deleted =)

Thanks,
djw

[wardk]

How about something like this? do the logging then die

if (!rmdir $_)
{
  open(LOG, ">>$logfile") or warn "discarding logfile output  \n";
  print LOG "Directory: $_ - had a problem deleting.\n";
  close (LOG) or warn "Can't close: $!";
  die "could not rmdir $_\n";
}

[lachoy]

In addition to what chromatic said, you can do this:

#!/usr/bin/perl -w

use strict;

BEGIN {
 open( ERRORLOG, ">> /tmp/test_error.log" ) || die $!;
}
END {
 close( ERRORLOG );
}

{
 $SIG{__WARN__} = sub { print ERRORLOG 'warn - ' . $_[0] };
 $SIG{__DIE__}  = sub { print ERRORLOG 'die  - ' . $_[0] };
 warn "Hey I told you so with that warning";
 eval { die  "Blah! It's a die command! that goes here" };
 print "dingle dongle goes here\n" 
}

Output is:

dingle dongle goes here

And contents of error.log are:

warn - Hey I told you so with that warning at test_sigdie.pl line 15.
die  - Blah! It's a die command! that goes here at test_sigdie.pl line
+ 16.

Note that die will still die if you don't wrap it in an eval {}. Also, since it's not installed yet the signal handler doesn't catch the die in the BEGIN block, so you don't need to worry about any bad things happening there. And also note that you can re-throw a warn or die from within the signal handler without getting into an infinite loop.

Redirecting error messages like this is really nifty, but once you get into using larger programs you need to be careful about doing this. Other modules might depend on die acting the normal way, so when you start throwing (for instance) hashrefs everywhere instead of plaintext you can run into some trouble. (At least, I thought I ran into trouble doing this, but maybe I just wasn't smart enough to get myself out of it :)

[djw]

Ok below is the modified product. Thanks for the suggestions. The only other thing that I would like to add is the ability to change the way the logs are handled. I would love to be able to have this:

** $date_script_was_run ***
File foo has been deleted.
File bar has been deleted.
Dir foobar has been deleted.

** $an_earlier_date_script_was_run ***
File foo has been deleted.
File bar has been deleted.
Dir foobar has been deleted.

Could I just add another sub to handle this and call the sub within the logging statements? So how could I change this to reflect that?


} else {
    open(ERRLOG, ">>$errorlog") or warn "scrapping error output\n";   
+ 
    eval { die "($!)"; };
        if ($@) { 
            print ERRLOG "Cannot delete dir $_ : $@!\n"; 
        }
    }


Anyhow, here is what I have so far. If you can give me a tip on what to look through, or point me in the right direction that would be great.


#!/usr/bin/perl -w
use strict;            
use File::stat; 
use File::Find qw(finddepth);

my($create_date, $current_date, $time_month, $month_old);
my($dir,$dirs,$logfile,$logfile2,$errorlog);


$_ = *File::Find::name;
$month_old = 2592000;
$current_date = time;
$dir = 'd:\data\Transfer';

$logfile = 'd:\data\log.txt';        
$logfile2 = 'd:\data\log_keep.txt';    
$errorlog = 'd:\data\errorlog.txt';    

finddepth \&deletion, $dir;


#
# Start of my function 'deletion'
#

sub deletion {
if (-f) {
    $create_date = stat($_)->ctime;
    if ($create_date < ($current_date - $month_old)) {
        if (unlink ($_)) { 

            open(LOG, ">>$logfile") or warn "discarding logfile output
+\n";
            print LOG "FIle: $_ - has been deleted.\n";
            close (LOG) or warn "Can't close $logfile: $!";

        } else {

            open(ERRLOG, ">>$errorlog") or warn "scrapping error outpu
+t\n";
            eval { die "($!)"; };
            if ($@) { print ERRLOG "Cannot delete file $_ : $@!\n"; }
        }

    } else {

        open(LOG, ">>$logfile2") or warn "discarding logfile output\n"
+;
        print LOG "The file $_ is newer than 30 days.\n";
        close(LOG) or warn "Can't close $logfile2: $!";
    }
} else {
    $create_date = stat($_)->ctime;
    if ($create_date < ($current_date - $month_old)) {
        if (rmdir ($_)) {
    
            open(LOG, ">>$logfile") or warn "discarding logfile output
+\n";
            print LOG "Directory: $_ - has been deleted.\n";
            close (LOG) or warn "Can't close $logfile: $!";
    
        } else {

            open(ERRLOG, ">>$errorlog") or warn "scrapping error outpu
+t\n";
            eval { die "($!)"; };
            if ($@) { print ERRLOG "Cannot delete dir $_ : $@!\n"; }

        }            

    } else {

            open(LOG, ">>$logfile2") or warn "discarding logfile outpu
+t\n";
            print LOG "The dir $_ is newer than 30 days.\n";
            close(LOG) or warn "Can't close $logfile2: ($!)";

        }
    }
}


Thanks,
djw

[ColonelPanic]

I think maybe you could improve performance and make the code more concise by opening and closing the log files only once, at the beginning of the script. Just a thought.

Another (simpler?) way you could handle the errors is with your own error sub...

unlink ($_) or &error(1,"Unable to open file: $_");

sub error
   {
   open the log and print out stuff (including $!)
   if the first variable is 1, exit the script          (die style)
   if the first variable is 0, return to where you were (warn style)
   }

the advantage of a sub like that is that you can copy it to any script with no modification. It is a lot easier than messing with an error file every time.