Perlで一括して名前を変更してファイルを移動する

Question

.segファイルの上に2つのディレクトリを持つフォルダ名を含むように、それぞれのファイル名を変更する方法を探しています。例えば

私は

/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]を使用して移動することができます