Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

how to loop thorugh lots of folders in a directory using perl

Status
Not open for further replies.

DanielStead

Programmer
Dec 6, 2005
2
GB
i currently have a perl script that moves files to a different location but i need to add a bit of code that will loop thourgh all the folders in the directory as there are like 5,000 folders in the directory

code currently looks like this

#!/usr/bin/perl
use File::Copy;

opendir(DIR, "X:/Tera 2-1 Main/P&G/Done") or die("directory not found");
@contents = readdir DIR;

foreach $listitem ( @contents )
{
if ( - $listitem )
{
$oldlocation = "X:/Tera 2-1 Main/P&G/Done/$listitem";
$newlocation = "Z:/test/$listitem";
move($oldlocation, $newlocation);
}
else
{
#do nothing
}
}


closedir DIR;
 
Something like the following. (Please note, I don't have perl installed on this machine, so this code may require some tweaking)

Code:
#!/usr/bin/perl

use File::Copy;

sub copyfiles
{
  my $dir = shift;
  my $copydir = shift;

  opendir(DIR, $dir) or die "Cannot open directory: $!";
  my @contents = readdir DIR;
  closedir DIR;

  foreach my $record (@contents)
  {
    # recurse into subdirectories if a directory and not . or ..
    -d $record && copyfiles($record, $copydir) unless -l;
    # if it's a file
    if (-f $record)
    {
      #and if it ends in the following extensions
      #skip to the next file
      next if (($record =~/\.bak$/i) || ($record =~/~$/i));

      my @filename = (split /\//, $record);
      shift @filename;
      my $newfile = "$copydir";
      $newfile .= join("/", @filename);

      if (!(-e $newfile))
      {
		print qq(New file:  Copying);
        #move("$record", "$newfile") or die "Could not copy file $record : $! .";
      }
      #otherwise check file for age.  If less than 1 day old,
      # copy file to the backup server
      elsif ((-M $record) < 1.1)
      {
		print qq(Record is older than 1 day.  Copying);
        #move("$record", "$newfile") or die "Could not copy file $record: $! .";
      }
    }
  }
}

copyfiles("c:/temp", "c:/tmp");

- George
[/code]
 
using File::Find should work to traverse the folders, and File::Copy to copy them. You could probably also use the perl rename() function to move your files, which is really what File::Copy::Move does whenever possible.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top