user3781528 user3781528 - 3 months ago 6x
Perl Question

Bulk rename and move files in Perl

I’m searching for a way to rename each found

file to include the name of a folder two directories above the

For example I found a
file in


and would like to rename it


Once I renamed the file I would like to move it to


. Here is my current code:

#!/usr/bin/env perl

use warnings;
use strict;
use File::Find;
use File::Copy qw(copy);
use feature qw{say};
use File::Basename;

my $home="/data/";
my $location = $home."test_all_runs/".$ARGV[0];

# for example let location be tmp
#my $location="tmp";

sub find_vcf {
my $F = $File::Find::name;
#find . -type f \( -name "*.shtml" -or -name "*.css" \)
#if ($F =~ /(vcf$|oncomine\.tsv$)/ ) {
if ($F =~ /\seg$/ ) {
print "$F\n";
my $filePath = $F;
my ($filename, $directories, $extension) = fileparse($filePath, '.seg');
my $target = (split m{/}, $directories)[-2];
say "Target: $target";

my $newFilePath = "$directories$target$extension";
say $newFilePath;
#my @samplename = (); @samplename = split /\//, $F; print "The sample name is #############".$samplename[4]."\n";
#my $final_location = $location.$samplename[4]."\.seg";
#copy $F, $final_location;

find({ wanted => \&find_vcf, no_chdir=>1}, $location);


Use rename to move a file to a name destination and name. File::Spec makes the code OS independent. You can also check Path::Tiny for similar tasks.

The moves are saved in an array and excuted later, otherwise File::Find might move the same file several times as it walks the directories.

use warnings;
use strict;
use File::Find;
use File::Spec;

my $home = "/data";
my @location_parts = ($home, 'test_all_runs', 'TestRun');
push @location_parts, $ARGV[0] if @ARGV;
my $location = File::Spec->catdir(@location_parts);

my @moves;
sub find_seg {
    my $F = $File::Find::name;

    if ($F =~ /\.seg$/ ) {
        my @path_parts = File::Spec->splitdir($F);
        my $name = $path_parts[-3];
        my $target = File::Spec->catdir($location, "$name.seg");
        push @moves, [ $F, $target ];

find({ wanted => \&find_seg, no_chdir => 1 }, $home);
while (@moves) {
    my ($F, $target) = @{ shift @moves };
    warn "$F -> $target";
    rename $F, $target or warn "Can't move to $target";