使用 perl 唯一地重命名许多文件中的每一个

Question

我有一个包含 96 个要重命名的文件的文件夹。问题是每个文件名都需要一个唯一的更改......不像在每个名称的前面添加一个零或更改扩展名。进行搜索和替换是不切实际的。 以下是我要更改的名称示例：

newSEACODI-sww2320H-sww24_07A_CP.9_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07B_CP.10_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07C_CP.11_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07D_CP.12_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07E_R.1_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07F_R.3_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07G_R.4_sww2320H_sww2403F.fsa
newSEACODI-sww2320H-sww24_07H_R.5_sww2320H_sww2403F.fsa

我想用perl把上面的名字分别改成下面的名字：

SEACODI_07A_A.2_sww2320H_2403F.fsa
SEACODI_07B_A.4_sww2320H_2403F.fsa
SEACODI_07C_H.1_sww2320H_2403F.fsa
SEACODI_07D_H.3_sww2320H_2403F.fsa
SEACODI_07E_H.6_sww2320H_2403F.fsa
SEACODI_07F_H.7_sww2320H_2403F.fsa
SEACODI_07G_Rb.4_sww2320H_2403F.fsa
SEACODI_07H_Rb.9_sww2320H_2403F.fsa

这样的事情能做到吗？我有一个模糊的想法，我可能会制作一个包含新名称列表的文本文件，并将该列表称为@newnames。我会从当前文件名中创建另一个数组，并将其命名为@oldnames。然后我会做某种for 循环，其中@oldnames 中的每个元素$i 都被@newnames 中的相应$i 替换。

不过，我不知道如何从我当前的文件名中创建一个数组，因此我不确定这个模糊的想法是否正确。我将带有混乱名称的文件保存在一个名为“oldnames”的目录中。下面是我尝试从该目录中的文件名中创建一个数组：

#!/usr/bin/perl -w
use strict; use warnings;

my $dir = 'oldnames';
opendir ('oldnames', $dir) or die "cannot open dir $dir: $!";
my @file = readdir 'oldnames';
closedir 'oldnames';

print "@file\n";

上面似乎没有做任何事情。我迷路了。帮忙？

Answer 1

这里：

#!/usr/bin/perl
use warnings;
use strict;

use autodie;
use File::Copy;

# capture script name, in case we are running the script from the 
# same directory we working on. 
my $this_file = (split(/\//, $0))[-1];
print "skipping file: $this_file\n";

my $oldnames = "/some/path/to/oldnames";
my $newnames = "/some/path/to/newnames";

# open the directory
opendir(my $dh, $oldnames); 

# grep out all directories and possibly this script. 
my @files_to_rename = grep { !-d && $_ ne $this_file } readdir $dh;
closedir $dh;

### UPDATED ###
# create hash of file names from lists:
my @old_filenames = qw(file1 file2 file3 file4);
my @new_filenames = qw(onefile twofile threefile fourfile);
my $filenames = create_hash_of_filenames(\@old_filenames, \@new_filenames);
my @missing_new_file = ();  


# change directory, so we don't have to worry about pathing
# of files to rename and move... 
chdir($oldnames);
mkdir($newnames) if !-e $newnames;


### UPDATED ###
for my $file (@files_to_rename) {
    # Check that current file exists in the hash,
    # if true, copy old file to new location with new name
    if( exists($filenames->{$file}) ) { 
        copy($file, "$newnames/$filenames->{$file}");
    } else {
        push @missing_new_file, $file;
    } 
}


if( @missing_new_file ) { 
    print "Could not map files:\n", 
        join("\n", @missing_new_file), "\n";
}

# create_hash_of_filenames: creates a hash, where
# key = oldname, value = newname
# input: two array refs 
# output: hash ref 
sub create_hash_of_filenames {
    my ($oldnames, $newnames) = @_; 
    my %filenames = (); 

    for my $i ( 0 .. (scalar(@$oldnames) - 1) ) { 
        $filenames{$$oldnames[$i]} = $$newnames[$i];
    }

    # see Dumper output below, to see data structure
    return \%filenames;
}

自卸车结果：

$VAR1 = {
  'file2' => 'twofile',
  'file1' => 'onefile',
  'file4' => 'fourfile',
  'file3' => 'threefile'
};

运行脚本：

$ ./test.pl 
skipping file: test.pl
Could not map files:
a_file.txt
b_file.txt
c_file.txt

文件结果：

$ ls oldnames/
a_file.txt
b_file.txt
c_file.txt
file1
file2
file3
file4

$ ls newnames/
fourfile
onefile
threefile
twofile

Answer 2

您的代码有点奇怪，但它应该可以工作。您是在“oldnames”目录还是在它上面的目录中运行它？你应该在它上面的目录中。更标准的写法是这样的：

#!/usr/bin/perl -w
use strict; use warnings;

my $dir = 'oldnames';
opendir ( my $oldnames, $dir) or die "cannot open dir $dir: $!";
my @file = readdir $oldnames;
closedir $oldnames;

print "@file\n";

这将使用oldnames 中的所有文件填充@files，包括 '。'和 '..'。您可能需要根据重命名方式过滤掉这些内容。

Answer 3

你能用rename 做到这一点吗？如果我记得的话，它确实允许您使用 perl 代码和表达式作为参数。

真正的答案是@chrsblck 的答案，它会进行一些检查并且不会造成混乱。

为了比较，这里有一个凌乱的班轮可能就足够了。它依赖于您提供一个等效的新文件名列表，该列表将以正确的顺序重命名您的旧文件列表。也许对于您的情况（您不想对文件名进行任何编程转换），您可以只使用 shell 循环（见本文末尾）从文件中读取新旧名称列表。更好的perl 解决方案是将这些文件名列表中的both 放入两列，然后使用-a 开关、@F 和File::Copy 复制文件大约。

无论如何，以下是一些建议。

首先，设置：

 % vim newfilenames.txt # list new names one per line corresponding to old names.
 % wc -l newfilenames.txt # the same number of new names as files in ./oldfiles/
  8 newfilenames.txt
 % ls -1 oldfiles  # 8 files rename these in order to list from newfilenames.txt
 newSEACODI-sww2320H-sww24_07A_CP.9_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07B_CP.10_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07C_CP.11_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07D_CP.12_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07E_R.1_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07F_R.3_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07G_R.4_sww2320H_sww2403F.fsa
 newSEACODI-sww2320H-sww24_07H_R.5_sww2320H_sww2403F.fsa

如上安排文件，复制所有内容：

perl -MFile::Copy -E 'opendir($dh , oldfiles); @newfiles=`cat newfilenames.txt`; chomp @newfiles; @oldfiles = sort grep(/^.+\..+$/, readdir $dh); END {for $i (0..$#oldfiles){copy("oldfiles/$oldfiles[$i]", "newfiles/$newfiles[$i]"); }}'

不漂亮：你必须在@oldfiles 上使用grep 和sort 以摆脱. .. 并将数组元素按顺序排列。而且总是存在拼写错误可能会造成混乱并且很难弄清楚的风险。
如果您将旧名称和新名称放在几个文件中，您可以使用 shell 脚本执行此操作：

for i in `cat ../oldfilenames.txt` ; do ; done; for n in `cat ../newfilenames.txt`; do cp $i $n;

或者只是 cd 进入包含旧文件的目录并执行以下操作：

mkdir new
for i in * ; do ; done; for n in `cat ../newfilenames.txt`; do cp $i new/$n;

祝你好运！