Perl에서 일괄 이름 바꾸기 및 파일 이동

Question

.seg 파일 위에 두 개의 폴더가있는 폴더의 이름을 포함하도록 각각 찾은 .seg 파일의 이름을 바꾸는 방법을 찾고 있습니다. 예를 들어

나는

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

에 .seg 파일을 발견하고 내가

/data/test_all_runs/TestRun 

로 이동하고자하는 파일의 이름을 변경 일단

Focus-HD753.seg 

이름을 변경하고 싶습니다

또는 $ARGV[0]입니다. 당신이 File::Basename 모듈을 사용할 수있는 이름을 파일 이름 변경에 대한

#!/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은 코드를 OS 독립적으로 만듭니다. 유사한 작업에 대해서도 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

, 코어의 일부입니다 여기에 내 현재 코드입니다.

#!/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]를 사용하여 이동할 수 있습니다