Hey Patricia,
Thursday, July 19, 2001, 10:49:11 AM, my MUA believes you used
Internet Mail Service (5.5.2653.19) to write:
DPA> Okay I really am a newbie. This whole perl thing has confused
DPA> me. (Any suggestions on clarification to my confusion of the
DPA> language would be appreciated as well)
DPA> I am trying to create a script on an NT machine that will search through the
DPA> directories and find specific directories/folders and pars through them to
DPA> delete their contents and work it's way back out deleting as it goes. For
DPA> example I want to delete all folders that start with _vti but I can't
DPA> delete this until everything inside is deleted so I have to find this go
DPA> inside delete everything inside and then delete the folder and continue
DPA> doing this through an entire drive.
DPA> Is there a module I should be using? Can anyone give me suggestions as to
DPA> where to find info on such a script? I have the Programming Perl book from
DPA> Oreilly but it seems to be giving me info on UNIX and not so much for
DPA> windows.....
I had a similar need, and got some help from this list to come up with
the following... Not complete (especially the help), but it works.
Comments welcome <g>
<snip>
#!/perl -w
use strict;
use diagnostics;
use File::Find;
use File::Copy;
use File::Spec::Functions;
use File::Basename;
use XML::Simple;
use Data::Dumper; # print Dumper($config);
my (%Cfg, $DTS, $config, $RunningConfig, %Ext, $AGE, $Drive, $PassType, $StartDir,
$Archive, $PurgeDir, $Extensions, $StartPath); # set in BEGIN
# do I need all these variables in the my statement?
finddepth(\&MoveDecision, $StartPath); # a function of File:Find
sub MoveDecision { # finddepth calls this for each hit
# $File::Find::dir contains the current directory name
my $dir = $File::Find::dir;
# we are creating $newdir with the $Archive top dir
(my $newdir = $dir) =~ s/$StartDir/$Archive/;
#(my $newdir = $File::Find::dir) =~ s/$StartDir/$Archive/;
my $lcNewDir = lc($newdir); # Ignore case for the "if"s
if ($PassType eq 'AGE') {
if (-M > $AGE) {
&DoTheMove($newdir, $dir);
}
} elsif ($PassType eq 'DIR') {
$PurgeDir = lc($PurgeDir);
if ($lcNewDir =~ /$PurgeDir/) {
&DoTheMove($newdir, $dir);
}
} elsif ($PassType eq 'EXT') {
if (ByExt($Extensions) eq "ExtMatch") {
&DoTheMove($newdir, $dir);
}
}
}
sub BuildConfig {
$Drive = $config->{Drive};
$StartDir = $config->{StartDir};
$Archive = $DTS; # Created in root of $Drive
$AGE = $config->{AGE}; # days
$PurgeDir = $config->{PurgeDir}; # Directory string to look for.
$Extensions = lc($config->{Extensions});
$StartPath = "$Drive/$StartDir";
# Set vars to determin how we are going to run!
$PassType = uc($config->{PassType});
my $CommonConfig = "
PassType = $PassType\n
StartPath = $StartPath
Archive = $Drive/$Archive";
if ($PassType eq 'AGE') {
$PurgeDir = "all"; # Not used in this configuration, so do everything
$Extensions = "all"; # Not used in this configuration, so do everything
$RunningConfig = $CommonConfig . "
Age = $AGE days";
} elsif ($PassType eq 'DIR') {
$AGE = 0; # Not used in this configuration, so do everything
$Extensions = "all"; # Not used in this configuration, so do everything
$RunningConfig = $CommonConfig . "
PurgeDir = $PurgeDir ";
} elsif ($PassType eq 'EXT') {
$AGE = 0; # Not used in this configuration, so do everything
$PurgeDir = "all"; # Not used in this configuration, so do everything
$RunningConfig = $CommonConfig . "
Extensions = $Extensions ";
} else {
print "\n\tError, Check your xml file\n";
exit;
}
#print qq[\n\tAGE=$AGE, Extensions=$Extensions, PurgeDir=$PurgeDir\n];#testing
}
sub ByExt {
my $ExtList = shift; # set $ExtList to 1st element of @_
return "ExtMatch" if ($ExtList =~ /all/); # this is to catch all ext's
return 0 if (-d); # get out if we are processing a dir
my @FN = split (/\./, $_);
if (@FN > 1) {
return "ExtMatch" if ($ExtList =~ /$FN[-1]/);
#print "\n EXT-MATCH!\t$FN[-1]" if ($ExtList =~ /$FN[-1]/); # testing
}
}
sub DoTheMove {
my $newdir = shift; # set $dir to 1st element of @_ ($newdir)
my $dir = shift; # set $dir to 1st element of @_ ($newdir)
GenDirs($newdir); # call the sub to create direcotries
return "isDir" if (-d);
if (lc($config->{Copy}) eq "copy") {
copy($_, catfile($newdir, $_));
} else {
move($_, catfile($newdir, $_));
}
LOG("\n".catfile($dir, $_));
}
sub GenDirs { # 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 GenDirs again unless $parent is a dir (if exists)
GenDirs($parent) unless -d $parent;
mkdir $dir; # create a directory (what this sub does)
}
sub CreateCFG {
my $FN = shift; my $cfgFN = $FN . ".xml";
print "\n\tThe config file does not exist, creating $cfgFN.";
print "\n\tPlease check that the settings are what you need.\n";
my $xmlCfgContents = qq[
<config>
<!-- Character Case does not matter, but watch out for leading or trailing spaces!
-->
<PassType>DIR</PassType>
<!-- Valid PassType entries: DIR EXT AGE -->
<Drive>d:</Drive>
<StartDir>!users</StartDir>
<AGE>2</AGE>
<PurgeDir>New Folder</PurgeDir>
<Extensions>COM EXE GIF JPEG JPG MP3 MPEG MPG</Extensions>
<Copy>copy</Copy>
<!-- The "Copy" tag runs a copy if the value is "copy" and a "move" if it is
anything else -->
</config>
];
open (xmlCfg, ">$cfgFN") || die "Can't create $cfgFN : $!";
print xmlCfg $xmlCfgContents; # Create config file
print $xmlCfgContents; # & write to STDOUT
close xmlCfg;
CreateHTMLdoc($FN);
}
sub LOG { #Where do we open the File Handle Log?
my $LogEntry = shift;
print $LogEntry; # Create Log file
print Log $LogEntry; # Create Log file
}
sub CreateHTMLdoc { # change this to POD format!
my $FN = shift; my $docFN = $FN . "Doc.html";
my $xmlCfgContents = shift;
open(Doc, ">$docFN") || die "Can't create $FN : $!";
my $POD = `pod2html $0`; print Doc $POD;
print Doc <<endDOCS; # Doc's here.
<html> <head>
<meta name="Author" content="Timothy L Musson">
<title>Network Drive Cleanup Utility $0</title>
</head> <body>
<b>Network Drive Cleanup Utility</b> ($0)<p>
The intent is to run this in 3 general passes:
Directory, Extension, then Age.<p>
This way the Directory pass gets both extensions and old files
(less for subsuquent passes). Then the Extension pass gets
old files, and finaly all the Old files that were not
archived by previous passes.
<pre>
1. <b>Directory</b> pass - Archive Directories (Program Files, WinNT, etc)
Set AGE = 1
Set Extensions = All #Note, if first ext is "All", we do them All!
PurgeDir = Program Files #only 1 directory per pass!
2. <b>Extension</b> pass - Archive files by Extension
Not implemented yet!
Set AGE = 1
Set Extensions = com exe gif jpeg jpg mp3 mpeg mpg
Set PurgeDir = Scan All Dirs
3. File <b>Age</b> pass - Archive files yb Age (in days)
Set AGE = 365 #days
Set Extensions = All
Set PurgeDir = Scan All Dirs
</pre>
Note: this is all a file move... This means that the old
directories are left intact. Will have to skulk out and
get them at another time.
</body> </html>
endDOCS
close Doc;
exit;
}
BEGIN { # $DTS, ><.cfg, >*Doc.html
#Sec=$T[0],M=1,H=2, mDay=3,Mon=4,Yr=5, wDay=6,yDay=7, isdst=8
my (@T) = localtime(time); $T[5]=1900+$T[5]; ++$T[4];
$DTS = qq[$T[5]y$T[4]m$T[3]d$T[2]h$T[1]m$T[0]s]; #
my @FN = split (/\./, $0); # put Filename & Ext in @FN elements
if (!-e "$FN[0].xml") { # Create a config file (if not exists)
CreateCFG($FN[0]);
} else { # Read config";
$config = XMLin();
BuildConfig();
} # end if/else create/read .cfg
my $CopyNote = "\n\tNote: Running a " . lc($config->{Copy}) . "\n" if
$config->{Copy};
my $logFN = $Archive. ".log";
#print "The logFN is ", $logFN;
open (Log, ">>$logFN");# || die "Can't create $logFN : $!";
LOG($CopyNote."$RunningConfig"."\n\nStarting at $T[2]:$T[1]:$T[0]\n");
#exit; # testing
} # end BEGIN
END { # write the ending time to the log file and screen.
#Sec=$T[0],M=1,H=2, mDay=3,Mon=4,Yr=5, wDay=6,yDay=7, isdst=8
my (@T) = localtime(time); $T[5]=1900+$T[5]; ++$T[4];
$DTS = qq[$T[5]y$T[4]m$T[3]d$T[2]h$T[1]m$T[0]s]; #
LOG("\n\nStarting at $T[2]:$T[1]:$T[0]\n");
}
=head1 NAME
<DriveCleanup> - Archive network file system files
=head1 SYNOPSIS
B<DriveCleanup> reads (or creates if it does not exist) DriveCleanup.xml - the
configuration file. Then moves files to another directory, maintaining the directory
structure, for archive.
=head1 DESCRIPTION
F<DriveCleanup> recurses through the directery structure & moves files
(retaining the directory structure) to a new toplevel directory. The new
top level directory is generated based on the current Date Time Stamp and
is in the format of YYYYyMMmDDdHHhMMmSSs (the upper case letters will be
numbers).
=head1 OPTIONS
=over 5
=item B<DriveCleanup.xml>
looks like this
<config>
<!-- Character Case does not matter, but watch out for leading or trailing spaces!
-->
<PassType>DIR</PassType>
<!-- Valid PassType entries: DIR EXT AGE -->
<Drive>d:</Drive>
<StartDir>!users</StartDir>
<AGE>2</AGE>
<PurgeDir>New Folder</PurgeDir>
<Extensions>COM EXE GIF JPEG JPG MP3 MPEG MPG</Extensions>
<Copy>copy</Copy>
<!-- The "Copy" tag runs a copy if the value is "copy" and a "move" if it is
anything else -->
</config>
=back
=head1 VERSION
This is Version 1.0
=head1 AUTHOR
=over 5
=item Coded by
Tim Musson <[EMAIL PROTECTED]>
=item written on
100% recycled electrons!
=back
=head1 ToDo:
=over 5
=item *
I can't think of anything... <g>
=back
=head1 Change History:
=over 5
=item *
7/2/2001 - changed config format to xml using XML::Simple
=item *
7/3/2001d - added POD
=item *
7/9/2001a
=over 5
=item *
both RO and Excel Open files are copied.
=item *
Move - Excel Open file was not moved, code just kept going <g> RO file was moved.
=item *
html now outputs POD - still need to strip old html output.
=over 5
=item *
7/10/2001 - log file is created in same dir as DriveCleanup is run from.
=back
=cut
</snip>
--
[EMAIL PROTECTED]
Using The Bat! (http://www.ritlabs.com/the_bat/) eMail v1.53d
Windows NT 5.0.2195 (Service Pack 1)
I have an imaginary friend who refuses to play with me.
NetZero Platinum
No Banner Ads and Unlimited Access
Sign Up Today - Only $9.95 per month!
http://www.netzero.net
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
