Bryan Harris wrote:
>
> I need to process one folder structure into a new folder structure, e.g.
> replace the word "dog" with "cat" recursively down through a folder, writing
> the updated files into a new structure:
>
> % ls
> myfolder1
> % dog2cat myfolder1
> dog2cat: myfolder1 --> myfolder1.cat
> % ls
> myfolder1 myfolder1.cat
>
> Where myfolder1.cat has all the contents of myfolder1, except that all
> occurrences of "dog" in any of the files have been replaced with "cat".
>
> My problem has been generating the new folder structure at the cwd. Has
> anyone seen this done before? I know mostly how to use File::Find, but it
> gets sticky because it doesn't provide a relative pathname for each new file
> to the original path supplied. There's got to be an easier way than what
> I'm doing (see below). It's main problem right now is that it doesn't work
> if the user happens to supply a starting folder like
> "myfolder1/mysubfolder1".
Hi Bryan.
Take a look at Path::Class to manipulate relative paths and File::Path to
create complete paths if the don't exist. The code below creates a new
absolute path for the source and destination directories and then, within
File::Find's Wanted routine, calculates the contents of $File::Find::name
relative to the source directory and then absolutely within the destination
directory. The result is the full path to the new file.
I've put code in to create the new path, but nothing to edit the files. All
you need to do is open $file for reading and $copy for writing.
HTH,
Rob
use strict;
use warnings;
use File::Find;
use Path::Class;
use File::Path qw/mkpath/;
my $from = Path::Class::Dir->new('myfolder1')->absolute;
my $dest = Path::Class::Dir->new('myfolder1.cat')->absolute;
find(\&process, $from);
sub process {
my $file = Path::Class::File->new($File::Find::name);
my $copy = $file->relative($from)->absolute($dest);
print $copy, "\n";
my $newpath = $copy->dir;
mkpath "$newpath";
#
# stuff to copy the files
#
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
