Re: Age of directories again with a specified directory

dont know if this is what your looking for.

#!/usr/bin/perl
use strict;
use File::Find::Rule;
use File::Copy;

my $directory = 'F';
my $newlocation = 'a';

my @subdirs = File::Find::Rule->directory->in( $directory );

foreach my $dir (@subdirs){
  #stat
  move("$dir", "$newlocation/$dir");
}
[download]

Comment on Re: Age of directories again with a specified directory Download Code

Replies are listed 'Best First'.

Re^2: Age of directories again with a specified directory
by dilip_val (Acolyte) on Nov 12, 2007 at 19:18 UTC

use warnings;
use File::Copy;
use File::Spec::Functions qw( catfile );
use File::Find;

my $dir = 'F:\\test';
my $newlocation = 'F:\\oldbackups';
opendir(my $dh, $dir)
   or die("Can't open directory \"$dir\": $!\n");

my @dirs;
while (defined(my $fn = readdir($dh))) {
   next if $fn eq '.' || $fn eq '..';
   my $qfn = catfile($dir, $fn);
   if (-d $qfn && -M $qfn > 0) {
      push @dirs, $qfn;  # or $fn
   }
}

foreach (@dirs) {
print("Directory to be moved : $_\n");
}

foreach my $dr (@dirs){
  move("$dr", "$newlocation") || die "$!";
  print "Moved $dr to $newlocation\n";
}

output:

D:\Software\scripts>cqperl test2.pl
Directory to be moved : F:\test\New Folder (2)
Directory to be moved : F:\test\New Folder (3)
Directory to be moved : F:\test\New Folder (4)
Directory to be moved : F:\test\test2
Permission denied at test2.pl line 26.
[download]

[reply]
[d/l]


good chemistry is complicated, and a little bit messy -LW
	PerlMonks