Hey all you great Perlers,
I am helping out my Win32 Server Admin team. They need to clean up
the "network drives". Currently ~40Gb of data. We are looking at
making 3 passes.
1. Folders - for example the "Windows" and "WinNT" folders (people
were asked to backup their *data* so of course copied
all of the C: drive...)
2. File Extensions - for example .exe & .jpg
3. Files older than XXX days (3 years I think).
I asked before and go great help creating the program for #3, but of
course now that they know how great Perl is, they want it to do the
rest also <g> (score one for perl...).
Here is my code for the "older than" pass. Should I create entirely
different code for the "Folders" and "Extension" passes, or
can/should this be modified?
<code>
#!/perl -w
use strict;
use diagnostics;
use File::Find;
use File::Copy;
use File::Spec::Functions;
use File::Basename;
# ===================================================================
# ====You can change the following variables=========================
my $AGE = 2; # days
my $Drive = "d:";
my $StartDir = "!users";
my $Archive = "Archive2CD"; # this gets created if it does not exist
my $PurgeDir = "Move Files";
# ====End of the variables you can change============================
# ===================================================================
# Commented for the non perl people
my $StartPath = "$Drive/$StartDir"; # don't change this one
#print "StartPath =\t$StartPath\nArchive =\t/$Archive\n"; # testing
# the next code fragment is using a function of File:Find
# the syntax is finddepth(\&sub, /path/to/start/in);
# Comments on my comments on this one? I was not sure...
finddepth(\&moveFiles, $StartPath);
sub moveFiles { # finddepth calls this for each hit
if (-M > $AGE) { # do this if the file is older than $AGE
#print "\$File::Find::dir =\t$File::Find::dir\n"; # testing
# $File::Find::dir contains the current directory name
# so we are creating $newdir with the $Archive top
(my $newdir = $File::Find::dir) =~ s/$StartDir/$Archive/;
if ( $newdir =~ /$PurgeDir/ ) {
print "\$newdir =\t\t$newdir\n"; # want *some* screen output... <g>
gen_dirs($newdir); # call the sub to create direcotries
copy($_, catfile($newdir, $_)); # this can be move...
}
}
}
sub gen_dirs { # create the dirs if they do not exist
my $dir = shift; # set $dir to 1st element of @_ ($newdir)
return if -d $dir; # return from sub if $dir is a directory
my $parent = dirname($dir); # $parent is set to the path of $dir
# run gen_dirs again unless $parent is a dir (if exists)
gen_dirs($parent) unless -d $parent;
mkdir $dir; # create a directory (what this sub does)
}
</code>
--
[EMAIL PROTECTED]
Using The Bat! eMail v1.53bis
Windows NT 5.0.2195 (Service Pack 1)
You're just jealous because the voices are talking to ME, not you!
