Hey Pete,
Not sure why you want to call ls when Perl can do the same thing. I
asked the list a similar question (I needed to move old files to a
different top directory - retaining the path to each file) a couple
weeks ago and got the following. (btw, I run this on Win32, so you
will need to change some things...)
Comments welcome! :-)
<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============================
# ===================================================================
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 fuction of File:Find
# the syntax is finddepth(\&sub, /path/to/start/in);
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>
Monday, June 18, 2001, 11:22:53 AM, you wrote:
PE> I've written a short program to recursively delete
PE> files/directories that haven't been modified in a certain length
PE> of time. It appears to work, but in the interest of improving my
PE> code/coding skills, I'd like to get any/all comments and
PE> criticisms, particularly about the way I handled getting the file
PE> information (using @ls=`ls -A $dir`). Thank you. Pete
PE> #!/usr/bin/perl -w
PE> use strict;
PE> use File::stat;
PE> my $startingdir="/tmp"; # could use $ARGV[0] here to make it more
PE> generic
PE> my $cutoff=5; # could also pass in the cutoff from
PE> the CLI
PE> &Purge($startingdir);
PE> ########## Subroutines #############
PE> sub Purge {
PE> (my $dir)=@_;
PE> my @ls=`ls -A $dir`; # All files except . and ..
PE> foreach my $file (@ls) {
PE> chomp $file;
PE> my $date= ( -M "$dir/$file" ); # -M = age of file (at startup) in
PE> days since modification
PE> if ($date>$cutoff) { # If the file/directory is greater
PE> than $cutoff days old ...
PE> print "Purging $dir/$file\n";
PE> system("rm -rf $dir/$file"); # Delete recursively and force it
PE> } elsif ( -d "$dir/$file" ) { # otherwise if it's a directory ...
PE> print "Recursing into $dir/$file ...\n";
PE> &Purge("$dir/$file"); # Recurse into it
PE> }
PE> }
PE> }
--
[EMAIL PROTECTED]
Using The Bat! eMail v1.53bis
Windows NT 5.0.2195 (Service Pack 1)
I was the next door kid's imaginary friend.
