使用 perl 进行文件名和路径操作

Question

我有以下代码。它工作正常，但我正在努力使其更通用。

代码的作用： 它遍历从某处作为输入提供的数组。数组的值是文件的路径。

例如：/path/to/file/location/ABC_XYZ12345678912_120215_010018654_PQR-HWL-Datafile.tar.gz

现在它获取数组中的每个元素并尝试删除文件名的第一部分“ABC_XYZ12345678912_120215_010018654_”，然后创建一个具有相同路径但文件名只有最后一部分的文件的新副本。例如： /path/to/file/location/PQR-HWL-Datafile.tar.gz.

文件名的开头部分将始终如上（模式明智），即 ABC_14DigitAlphanumric_monthdateyearpatter(6 digits)_9digit more。

代码运行良好。

现在我对下面的代码有两个问题。

1> 与做一些硬编码的东西相比，如何使我提取文件名最后一部分的部分更通用：（使用一些正则表达式或类似的东西）

my ( $file, $dir ) = fileparse($individualFile);

# how this part can be made more generic so that i can directly extract the name of last part of file as compared doing hard code comparison 
if ( $file =~ 'PQR-HWL-Datafile.tar.gz' ) {
   $newFileName = "PQR-HWL-Datafile.tar.gz";
}elsif ( $file =~ 'data_value_most_recent.bin.gz' ){
   $newFileName = "data_value_most_recent.bin.gz";
}

my $absPathToNewFile = File::Spec->catfile( $dir, $newFileName );

2> 其次，复制操作如下所示，或者可以避免创建副本：

copy($individualFile, $absPathToNewFile); =======>（变成这样或更少硬编码）

复制（文件_with_original_name，文件_with_new_file_name

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use File::Copy;

my @filePathArray =     
('/path/to/file/location/ABC_XYZ12345678912_120215_010018654_PQR-HWL-    

Datafile.tar.gz','/path/to/file/location/ABC_XYZ12345678912_120215_010018654_data_value_most_recent.bin.gz');

my $newFileName;
foreach my $individualFile (@filePathArray) {

  my ( $file, $dir ) = fileparse($individualFile);

  if ( $file =~ 'PQR-HWL-Datafile.tar.gz' ) {
     $newFileName = "PQR-HWL-Datafile.tar.gz";
  }elsif ( $file =~ 'data_value_most_recent.bin.gz' ){
     $newFileName = "data_value_most_recent.bin.gz";
  }

  my $absPathToNewFile = File::Spec->catfile( $dir, $newFileName );
  copy( $individualFile, $absPathToNewFile );
}

Answer 1

1) 如果你知道你的模式，你可以简单地为它编写正则表达式并用空字符串替换它，就像这样：

my $old_filename = "ABC_XYZ12345678912_120215_123456789_PQR-HWL-Datafile.tar.gz";

# pattern described in the question
my $pattern = qr/^ABC_[A-Za-z0-9]{14}_\d{6}_\d{9}_/;

( my $new_filename = $old_filename ) =~ s/$pattern//;

print "new_filename: $new_filename\n";
print "old_filename: $old_filename\n";

2) 我认为复制部分没有任何问题。可能我没听懂。