Peer Review for Folder Delete Script

C

Cosmic Cruizer

I'm looking for a peer review of the following code. I ran into quite a
few issues while developing it, so I think it best if I have additional
eyes looking at it.

There is a W2K3 drive that contains a folder that has multiple "job"
folders. Each job folder may contain additional folders, along with a
number of files. When the job folder's creation date exceeds a certain
number of days, the complete folder and all its contents need to be
deleted.

Here is my code. All feedback is welcomed.

#########################################################################
######
# File Name: directory_cleanup.pl
#
# WARNING: This script can be very unforgiving and damaging. Make sure
the
# the correct path is listed, otherwise extreme data loss my
occur!
#
# Assumes: Perl is installed on the Windows computer used to run this
script.
# (NOTE: This script was designed to run on a Windows
computer.) The
# user or account running this script has permissions to delete
all
# files and folders in the targeted path.
#
# This script removes folder structures that are past a listed number of
days.
# It will only analyze folders in the base directory and will ignore
files.
#
# $days is the number of days that are kept. All directories older than
$days
# will be deleted along with all of the contents of those directories.
#
# $base_dir is the base directory where the targeted directories are
checked
# for the date they were created and deleted if older than $days.
#
# A logfile is created on first use of this script and updated there
after
# each time this script runs. The current local time is added, then each
# directory that is deleted is recorded. If no directories are delete,
an
# entry noting "No directories deleted" is added.
#
# If a directory cannot be deleted, it will have two entries in the log:
# The first will say "Could not remove...", but then it will follow
that
# it was removed. It may be the case were most of the contents were
# removed, but not the final directory. In this case, remove the
directory
# manually. (You may need to unlock some items or they were in use.)
#
# NOTE: Once a directory and its files are deleted, they cannot be
undeleted!
#
# Created by: xxxxxxxxx
# Date: January 22, 2009
#
#########################################################################
######
use strict;
use File::Find;

my $base_dir='E:\Jobs'; # Add root name of folder to be
managed
my $days=31; # Change to number of days to keep

### Do not change anything below this line ###

my $output = 'delete_directories.txt';
my $deltime=time-$days*86400;
my $delete_flag = 0; # Flag to check for any deletions
my ($month, $day, $year) = (split / /, scalar localtime)[1,2,4];

open(OUT," >> $output") || die $!; # Open output file for logging
print OUT "$month $day, $year\n"; # Add current date to output file

opendir(DIR,$base_dir) || die $!; # Get list of directories
my @children = grep !/^\./, readdir (DIR);
closedir (DIR);

foreach my $child (@children) {
my $entry = $base_dir . '\\' . $child;

if (-d $entry){ # If the "entry" is a folder, process
it
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,
$ctime,$blksize,$blocks)=stat($entry);
my $ftime=$mtime;

if ($ftime<$deltime) { # If folder is older than $days,
remove it
# The next two lines finds the directory structure and does the
removal
finddepth (\&remove_dir, "$entry");
rmdir ( "$entry" ) or print OUT "\tCould not remove $entry\n";

$delete_flag = 1; # Set flag to record a directory was
deleted
print OUT "\t$entry\n"; # Write delete directory to log
file
}
}
}
print OUT "\tNo directories deleted\n", if($delete_flag eq 0);
print OUT "\n"; # Add a final line feed for readability
close(OUT);

exit;


### Subroutines ###

sub remove_dir { # Remove files and directories
# for a directory, this will be 0
if ( ! (stat("$File::Find::name"))[7] ) {
rmdir("$File::Find::name");
}
else {
unlink("$File::Find::name");
}
}
 
U

Uri Guttman

CC> #
CC> # A logfile is created on first use of this script and updated there
CC> after

first off, paste it cleanly so you don't get line wrapping. this will
not compile as is since there are lines with comment text without
leading # chars. this is all over the script.

CC> use strict;

use warnings too.

CC> use File::Find;

CC> my $base_dir='E:\Jobs'; # Add root name of folder to be
CC> managed

another wrapped line.

CC> my $days=31; # Change to number of days to keep

use horizontal whitespace. it is free.

my $days = 31;

don't put comments on a line with the code. better to put them on the
line before the code. you have more room to work with and it reads much better.

CC> ### Do not change anything below this line ###

CC> my ($month, $day, $year) = (split / /, scalar localtime)[1,2,4];

if you called localtime in a list context, you could slice out the parts
you want without split. or use strftime.

CC> opendir(DIR,$base_dir) || die $!; # Get list of directories
CC> my @children = grep !/^\./, readdir (DIR);

that removes ALL files starting with ., not just . and .. which is what
i think you are trying to remove.

CC> closedir (DIR);

just a little tweak here. File::Slurp has a read_dir func which does
that and it removes . and .. for you.

use File::Slurp ;
my @children = read_dir($base_dir) ;

CC> foreach my $child (@children) {
CC> my $entry = $base_dir . '\\' . $child;

interpolation is easier to read:

my $entry = "$base_dir\\$child" ;

also iirc you can use / for dir separators on windows for all file
operations. only the cmd shell requires \.

CC> if (-d $entry){ # If the "entry" is a folder, process
CC> it
CC> my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,
CC> $ctime,$blksize,$blocks)=stat($entry);
CC> my $ftime=$mtime;

why declare and not use all those stat values? you know how to do a
slice (you did one with localtime) so do that here.

CC> if ($ftime<$deltime) { # If folder is older than $days,
CC> remove it
CC> # The next two lines finds the directory structure and does the
CC> removal
CC> finddepth (\&remove_dir, "$entry");

useless quoting of a scalar. this could be a bug in some cases.

CC> rmdir ( "$entry" ) or print OUT "\tCould not remove $entry\n";

same thing.


CC> ### Subroutines ###

CC> sub remove_dir { # Remove files and directories
CC> # for a directory, this will be 0
CC> if ( ! (stat("$File::Find::name"))[7] ) {
CC> rmdir("$File::Find::name");
CC> }
CC> else {
CC> unlink("$File::Find::name");

all those are just scalars with a long name. no need for the quotes

and -d tests for a directory so why the complex code? you use -d
earlier so you know it.

uri
 
U

Uri Guttman

CC> Thanks for your input uri.
CC> Some of my code probably ended up pretty sloppy since my 60 minute project
CC> turned into about 3 hours worth of frustrations. (Fortunately, I was
CC> running it on a test system, so no real data loss occurred.)

CC> For example, I should not have needed someone to point out I
CC> should have used: my $mtime = (stat($entry))[9] instead of the
CC> long drawn out method I

and there are -X entries that will get you info like that so you can
avoid the stat slice too.

CC> I also simplified a few other items and cleaned up the superfluous
CC> syntax. (But I kept the end of line comments because that's how I
CC> like to do it... and at least I add comments.)

good for you that you add comments. how you like to do it is not as
important as how people like to read. perl style is generally not to
comment on the same line and you don't see it much in perl code. so it
is better for you to adhere to the more common style of comments on
their own lines. and as i said you get more room and multiline comments
work. also you can line wrap those comments (most decent editors can do
this) with a command to keep them readable.

uri
 
J

John W. Krahn

Cosmic said:
Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute project
turned into about 3 hours worth of frustrations. (Fortunately, I was
running it on a test system, so no real data loss occurred.)

For example, I should not have needed someone to point out I should have
used: my $mtime = (stat($entry))[9] instead of the long drawn out method I
originally used. But then again... that's why we have code reviews. ;)


I also simplified a few other items and cleaned up the superfluous syntax.
(But I kept the end of line comments because that's how I like to do it...
and at least I add comments.)

Thank you very much!

One thing that Uri failed to mention, in the line:
my ($month, $day, $year) = (split / /, scalar localtime)[1,2,4];

You are using the pattern / / which will not work correctly on all dates:

$ perl -le'print for ( split / /, localtime 1232827200 )[1,2,4]'
Jan
24
2009
$ perl -le'print for ( split / /, localtime 1231358400 )[1,2,4]'
Jan

12:00:00


That is because a single digit day number will have *two* spaces in
front of it. You need to use the special split pattern ' ' instead:

$ perl -le'print for ( split " ", localtime 1231358400 )[1,2,4]'
Jan
7
2009



John
 
C

Cosmic Cruizer

Cosmic said:
Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute
project turned into about 3 hours worth of frustrations.
(Fortunately, I was running it on a test system, so no real data loss
occurred.)

For example, I should not have needed someone to point out I should
have used: my $mtime = (stat($entry))[9] instead of the long drawn
out method I originally used. But then again... that's why we have
code reviews. ;)


I also simplified a few other items and cleaned up the superfluous
syntax. (But I kept the end of line comments because that's how I
like to do it... and at least I add comments.)

Thank you very much!

One thing that Uri failed to mention, in the line:
my ($month, $day, $year) = (split / /, scalar localtime)[1,2,4];

You are using the pattern / / which will not work correctly on all
dates:

$ perl -le'print for ( split / /, localtime 1232827200 )[1,2,4]'
Jan
24
2009
$ perl -le'print for ( split / /, localtime 1231358400 )[1,2,4]'
Jan

12:00:00


That is because a single digit day number will have *two* spaces in
front of it. You need to use the special split pattern ' ' instead:

$ perl -le'print for ( split " ", localtime 1231358400 )[1,2,4]'
Jan
7
2009



John

Thanks John, but I had already changed it to use the following:
my $timestamp = localtime;

But the next time I use split with localtime, I will use the format you
showed.

....Cos
 
L

Larry Gates

Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute project
turned into about 3 hours worth of frustrations. (Fortunately, I was
running it on a test system, so no real data loss occurred.)

For example, I should not have needed someone to point out I should have
used: my $mtime = (stat($entry))[9] instead of the long drawn out method I
originally used. But then again... that's why we have code reviews. ;)


I also simplified a few other items and cleaned up the superfluous syntax.
(But I kept the end of line comments because that's how I like to do it...
and at least I add comments.)

Thank you very much!

...Cos

Please post a cleaned up version. I only looked at it cursorily as the
comments were worse than distracting. Which directory is deleted?
--
larry gates

But at some point you just give up and call it cheating, er,
I mean, AOP. :)
-- Larry Wall in <[email protected]>
 
S

sln

Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute project
turned into about 3 hours worth of frustrations. (Fortunately, I was
running it on a test system, so no real data loss occurred.)
So you are being paid to write this code under a deadline then.
For example, I should not have needed someone to point out I should have
used: my $mtime = (stat($entry))[9] instead of the long drawn out method I
originally used. But then again... that's why we have code reviews. ;)
And you are posting here to clean up you code (review) before anybody at
work see's it.
I also simplified a few other items and cleaned up the superfluous syntax.
(But I kept the end of line comments because that's how I like to do it...
and at least I add comments.)

Thank you very much!

...Cos

Jeez, where can I get a job like that?

sln
 
L

Larry Gates

You are using the pattern / / which will not work correctly on all dates:

$ perl -le'print for ( split / /, localtime 1232827200 )[1,2,4]'
Jan
24
2009
$ perl -le'print for ( split / /, localtime 1231358400 )[1,2,4]'
Jan

12:00:00


That is because a single digit day number will have *two* spaces in
front of it. You need to use the special split pattern ' ' instead:

$ perl -le'print for ( split " ", localtime 1231358400 )[1,2,4]'
Jan
7
2009



John

John,

I'm trying to split something on a space and was using / /. How again does
it differ from " "?

while (my $line = <$gh>) {

my @s = split / /, $line;
print STDOUT @s;
}

How could I send @s to STDOUT to see if I'm splitting where I think I am?
--
larry gates

It's certainly easy to calculate the average attendance for Perl
conferences.
-- Larry Wall in <[email protected]>
 
S

sln

You are using the pattern / / which will not work correctly on all dates:

$ perl -le'print for ( split / /, localtime 1232827200 )[1,2,4]'
Jan
24
2009
$ perl -le'print for ( split / /, localtime 1231358400 )[1,2,4]'
Jan

12:00:00


That is because a single digit day number will have *two* spaces in
front of it. You need to use the special split pattern ' ' instead:

$ perl -le'print for ( split " ", localtime 1231358400 )[1,2,4]'
Jan
7
2009



John

John,

I'm trying to split something on a space and was using / /. How again does
it differ from " "?

while (my $line = <$gh>) {

my @s = split / /, $line;
print STDOUT @s;
}

How could I send @s to STDOUT to see if I'm splitting where I think I am?

From what I hear:

"As a special case, specifying a PATTERN of space (' ') will split on white space
just as split with no arguments does. Thus, split(' ') can be used to emulate awk's
default behavior, whereas split(/ /) will give you as many null initial fields as
there are leading spaces. A split on /\s+/ is like a split(' ') except that any
leading whitespace produces a null first field.
A split with no arguments really does a split(' ', $_) internally."

sln
 
C

Cosmic Cruizer

(e-mail address removed) wrote in
Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute
project turned into about 3 hours worth of frustrations. (Fortunately,
I was running it on a test system, so no real data loss occurred.)
So you are being paid to write this code under a deadline then.
For example, I should not have needed someone to point out I should
have used: my $mtime = (stat($entry))[9] instead of the long drawn
out method I originally used. But then again... that's why we have
code reviews. ;)
And you are posting here to clean up you code (review) before anybody
at work see's it.
I also simplified a few other items and cleaned up the superfluous
syntax. (But I kept the end of line comments because that's how I like
to do it... and at least I add comments.)

Thank you very much!

...Cos

Jeez, where can I get a job like that?

sln

No, I'm not a programmer and I don't get paid to write code. I write
code/utilities to make life easier on myself and others. The way I see it,
if there is a task that needs to be done more than once, automate it.

Generally, I don't post my code, but in this case, I kept deleting files
and directories I was not targeting. Therefore, I thought I would have
others look at it before I put it on a production system.

Besides, I find creating Perl programs is much more fun than doing
crossword puzzles. In both case, I'm not really very good at either one,
but that does not stop me from trying.
 
S

sln

(e-mail address removed) wrote in
Thanks for your input uri.

Some of my code probably ended up pretty sloppy since my 60 minute
project turned into about 3 hours worth of frustrations. (Fortunately,
I was running it on a test system, so no real data loss occurred.)
So you are being paid to write this code under a deadline then.
For example, I should not have needed someone to point out I should
have used: my $mtime = (stat($entry))[9] instead of the long drawn
out method I originally used. But then again... that's why we have
code reviews. ;)
And you are posting here to clean up you code (review) before anybody
at work see's it.
I also simplified a few other items and cleaned up the superfluous
syntax. (But I kept the end of line comments because that's how I like
to do it... and at least I add comments.)

Thank you very much!

...Cos

Jeez, where can I get a job like that?

sln

No, I'm not a programmer and I don't get paid to write code. I write
code/utilities to make life easier on myself and others. The way I see it,
if there is a task that needs to be done more than once, automate it.

Generally, I don't post my code, but in this case, I kept deleting files
and directories I was not targeting. Therefore, I thought I would have
others look at it before I put it on a production system.

Besides, I find creating Perl programs is much more fun than doing
crossword puzzles. In both case, I'm not really very good at either one,
but that does not stop me from trying.

Unfortunately, you really, really have to know what your doing to
automate deleting files and directories on a production machine.

This does not sound like a hobby nor crossword puzzles.
And your not a programmer, your just making life easier on behalf of
yourself and others.

Why didn't you just say from the outset your f*cking around for personal,
amatuer reasons, why make it sound like its a job?

If you had years of experience you wouldn't ask these questions. If you
don't, the production crap is out as far as a company. Either way its
sleezy sounding.

Stop blowing sunshine up peoples ass', your not fooling anybody.
In fact, nobody cares what your using the 'code review' for, maybe
as a non-programmer, you should stop slinging buzzwords so it doesen't
sound like your taking advantage of somebody here.

sln
 
C

Cosmic Cruizer

Please post a cleaned up version. I only looked at it cursorily as
the comments were worse than distracting. Which directory is deleted?

Larry,

Just in case you are still interested, here is the code without all the
comments. As Uri recommended, I tried File::Slurp. Since I do not have
the library on my local computer, I'm not sure if it is on the production
system, therefore, I did not implement that change.

This is pretty much what I will be trying next week. The bi-weekly full
backup was on Friday to a VTL, so if something does happen, it will be
relatively easy to have data restored.

use strict;
use File::Find;
# use warnings;

my $base_dir='E:\05-09-07\Cal Poly';
my $days=31;

my $output = 'delete_directories.txt';
my $deltime=time-$days*86400;
my $delete_flag = 0;
my $timestamp = localtime;

open(OUT," >> $output") || die $!;
print OUT "$timestamp\n";

opendir(DIR,$base_dir) || die $!;
my @children = grep !/^\./, readdir (DIR);
closedir (DIR);

foreach my $child (@children) {
my $entry = "$base_dir\\$child";

if (-d $entry){
my $mtime = (stat($entry))[9];
my $ftime=$mtime;

if ($ftime<$deltime) {
finddepth (\&remove_dir, $entry);
rmdir ( $entry ) or print OUT "\tCould not remove $entry\n";

$delete_flag = 1;
print OUT "\t$entry\n";
}
}
}
print OUT "\tNo directories deleted\n", if($delete_flag eq 0);
print OUT "\n";
close(OUT);

exit;


### Subroutines ###

sub remove_dir {
# for a directory, this will be 0
if ( ! (stat($File::Find::name))[7] ) {
rmdir($File::Find::name);
}
else {
unlink($File::Find::name);
}
}
 
T

Tad J McClellan

Larry Gates said:
You are using the pattern / / which will not work correctly on all dates:
That is because a single digit day number will have *two* spaces in
front of it. You need to use the special split pattern ' ' instead:

$ perl -le'print for ( split " ", localtime 1231358400 )[1,2,4]'

I'm trying to split something on a space and was using / /. How again does
^
^ John's code splits on *one or more* spaces
it differ from " "?


perldoc -f split

...
As a special case, specifying a PATTERN of space ...

print STDOUT @s;
How could I send @s to STDOUT to see if I'm splitting where I think I am?


print "'$_'\n" for @s;

or

print join(':', @s), "\n";

or

{ local $" = ':';
print "@s\n";
}
 
T

Tad J McClellan

Cosmic Cruizer said:
# use warnings;


You lose the benefits of that pragma when you comment it out...

my $base_dir='E:\05-09-07\Cal Poly';


my $base_dir='E:/05-09-07/Cal Poly';

open(OUT," >> $output") || die $!;


open my $OUT, '>>', $output or die "could not open '$output' $!";

print OUT "$timestamp\n";


print $OUT "$timestamp\n";

my $entry = "$base_dir\\$child";


my $entry = "$base_dir/$child";
 
C

Cosmic Cruizer

Hi Tad, it's been a few years since I've had the pleasure of you critiquing
my code. Your input is much appreciated.

When I use warnings, I generally only have it enabled while I'm testing.

I've never tried using open in the following format:
open my $OUT, '>>', $output or die "could not open '$output' $!";

I'll give it a try.

Thanks!
 
T

Tad J McClellan

Cosmic Cruizer said:
Hi Tad, it's been a few years since I've had the pleasure of you critiquing
my code.


Looks like April 2004 by my records.

When I use warnings, I generally only have it enabled while I'm testing.


Why?

There are many runtime warnings, they can catch things in production
that your test cases missed.

So there is a benefit.

What "cost" do you see that outweighs that benefit?

I've never tried using open in the following format:
open my $OUT, '>>', $output or die "could not open '$output' $!";


That is the standard idiom for opening files nowadays.

It makes use of the 3-arg form of open() and indirect filehandles.

I'll give it a try.


perldoc perlopentut

...
There is also a 3-argument version of open, which ...
...
Indirect Filehandles

open's first argument can be a reference to a filehandle. As of
perl 5.6.0, if the argument is uninitialized, Perl will automatically
create a filehandle and put a reference to it in the first argument
 
A

A. Sinan Unur

Here is my code. All feedback is welcomed.

#################################################################

Use

=for comment

File Name: directory_cleanup.pl

WARNING: This script can be very unforgiving and damaging. Make
sure the the correct path is listed, otherwise extreme data loss my
occur ...

=cut

instead of # characters for long block comments like that. Also,
s/my occur/may occur/.

Better yet, write your comments in a proper POD.
# WARNING: This script can be very unforgiving and damaging.

How about having the user type in the path and confirm? (or, is this
script going to be periodically invoked by a scheduler?)
my $base_dir='E:\Jobs';
my $days=31; ....

### Do not change anything below this line ###

I recommend that you consider the option of putting configuration
variables in configuration files.


Sinan


--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/
 
C

Cosmic Cruizer

Also, s/my occur/may occur/.

Caught it... but still thanks to your attention to detail :)

Better yet, write your comments in a proper POD.

I probably should have started using POD years ago, but some of the biggest
complements I get are on my consistent and copious comments. Recently some
utility/support scripts I wrote over eight years ago to support a vendor
supplied application were being reviewed in a project to replace that
application. Even though I was somewhat embarrassed about my awkward coding
(it was much worse back then), I was very pleased with how everyone said my
comments made it very easy to understand why and what the scripts are
doing. On the other hand, I've always written the comments so I can easily
figure out what the heck I did.
How about having the user type in the path and confirm? (or, is this
script going to be periodically invoked by a scheduler?)

This script will be scheduled to run once a week by the Windows scheduler.
While I would like to say this script is a case of "implement and
forget"... we all know that is not always the case.
I recommend that you consider the option of putting configuration
variables in configuration files.

In cases where I know the script will be used for multiple runs, I create
..conf files so the script can call them using @argv from the scheduler. In
this case, the script is being used to support a statement about why and
when the folders are removed. This script will provide the appropriate
amount of rigor without overkill.

Thanks!

....Cos
 
L

Larry Gates

Larry,

Just in case you are still interested, here is the code without all the
comments. As Uri recommended, I tried File::Slurp. Since I do not have
the library on my local computer, I'm not sure if it is on the production
system, therefore, I did not implement that change.

This is pretty much what I will be trying next week. The bi-weekly full
backup was on Friday to a VTL, so if something does happen, it will be
relatively easy to have data restored.

use strict;
use File::Find;
# use warnings;

my $base_dir='E:\05-09-07\Cal Poly';

CC,

I'd be interested in what you have after you make changes. I'm chipping
away at my own perl projects, so I've got plenty on my plate, but I'd like
to run and keep the final product. You've got some serious criticisms, ie,
seriously good suggestions, to deal with yet.

The directory erased is E:\05-09-07\Cal Poly , right?
--
larry gates

Chip Salzenberg sent me a complete patch to add System V IPC (msg, sem and
shm calls), so I added them. If that bothers you, you can always undefine
them in config.sh. :) -- Larry Wall in <[email protected]>
 
T

Tim Greer

Larry said:
The directory erased is E:\05-09-07\Cal Poly , right?

His code shows he opens that directory (mentioned above) and then checks
(and deletes) directories _within_ it that are over X days old.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,985
Messages
2,570,202
Members
46,777
Latest member
JosefinaAc

Latest Threads

Top