Bulk rename and move files in Perl - perl

Question

I’m searching for a way to rename each found .seg file to include the name of a folder two directories above the .seg file.
For example I found a .seg file in
/data/test_all_runs/TestRun/Focus-HD753/QC/diffCoverage.seg
and would like to rename it
Focus-HD753.seg
Once I renamed the file I would like to move it to
/data/test_all_runs/TestRun
or $ARGV[0]. Here is my current code:
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
use File::Spec;
my $home = "/data";
my #location_parts = ($home, 'test_all_runs');
push #location_parts, $ARGV[0] if #ARGV;
my $location = File::Spec->catdir(#location_parts);
my #moves;
my #vcf_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"); print $target;
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";
}
sub find_vcf {
my $V = $File::Find::name;
if ($V =~ /(vcf$|oncomine\.tsv$)/ ) {
my #path_parts = File::Spec->splitdir($V);
print "The path_parts at 0 is #############".$path_parts[0]."\n";
print "The path_parts at -1 is #############".$path_parts[-1]."\n";
print "The path_parts at -2 is #############".$path_parts[-2]."\n";
print "The path_parts at -3 is #############".$path_parts[-3]."\n";
print "The path_parts at 1 is #############".$path_parts[1]."\n";
my $target_vcf = File::Spec->catdir($location, $path_parts[-1]); print $target_vcf;
push #vcf_moves, [ $V, $target_vcf ];
print "$V\n";
}
}
find({ wanted => \&find_vcf, no_chdir=>1}, $home);
while (#vcf_moves) {
my ($V, $target_vcf) = #{ shift #vcf_moves };
warn "$V -> $target_vcf";
rename $V, $target_vcf or warn "Can't move to $target_vcf";
}

Answer 1

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.
#!/usr/bin/perl
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";
}

Answer 2

For the name file name modifications you could use File::Basename module, which is part of the core.
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{say};
use File::Basename;
my $filePath = "/data/test_all_runs/TestRun/Focus-HD753/QC/diffCoverage.seg";
my ($filename, $directories, $extension) = fileparse($filePath, '.seg');
my $target = (split m{/}, $directories)[-2];
say "Target: $target";
my $newFilePath = "$directories$target$extension";
say $newFilePath;
Result:
Target: Focus-HD753
/data/test_all_runs/TestRun/Focus-HD753/QC/Focus-HD753.seg
Then you can move it using $ARGV[0] to the location you want (maybe with File::Copy ?)