Массовое переименование и перемещение файлов в Perl

Question

Я ищу способ переименовать каждый найденный файл .seg, чтобы указать имя папки с двумя каталогами над файлом .seg.

Например, я нашел .seg файл в

/data/test_all_runs/TestRun/Focus-HD753/QC/diffCoverage.seg 

и хотел бы переименовать его

Focus-HD753.seg 

После того, как я переименовал файл, который я хотел бы, чтобы переместить его

/data/test_all_runs/TestRun 

или $ARGV[0]. Вот мой текущий код:

#!/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

Использование rename для перемещения файла в имя назначения и имя (возможно, с File::Copy?) , File::Spec делает код независимым от ОС. Вы также можете проверить Path::Tiny для выполнения аналогичных задач.

Перемещение сохраняется в массиве и вызывается позже, в противном случае File :: Find может перемещать один и тот же файл несколько раз, когда он перемещается по каталогам.

#!/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

Для модификации названия имени файла, которые вы могли бы использовать File::Basename модуль, который является частью ядра.

#!/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; 

Результат:

Target: Focus-HD753 
/data/test_all_runs/TestRun/Focus-HD753/QC/Focus-HD753.seg 

Затем вы можете переместить его с помощью $ARGV[0] на месте вы хотите