使用Perl重命名目录中的文件

Question

我想遍历一个目录，并且针对所有的邮箱（*.msg）文件，删除开头的“RE ”字符。我已经有了下面的代码，但是重命名失败了。

opendir(DIR, 'emails') or die "Cannot open directory";
@files = readdir(DIR);
closedir(DIR);

for (@files){
    next if $_ !~ m/^RE .+msg$/;
    $old = $_;
    s/RE //;
    rename($old, $_) or print "Error renaming: $old\n";
}

- Johnathan1

---

如果你打印出错误信息（$!），你可能会对问题有所了解... - pilcrow

谢谢您指出这个问题。错误是“没有这个文件或目录”。我很惊讶，因为$old文件名是准确的。 - Johnathan1

请注意，rename 函数不支持跨平台，而 File::Copy 的 move 函数则支持。 - Zaid

@Zaid：但它是否也保留权限，跨平台？ - reinierpost

Answer 1

如果您的./emails目录中包含以下文件：

1.msg
2.msg
3.msg

那么你的@files数组看起来会像这样：('.', '..', '1.msg', '2.msg', '3.msg')，但是rename命令想要的文件名形式是类似于'emails/1.msg'、'emails/2.msg'等等。因此，在重命名之前，你可以先使用chdir命令更改当前目录：

chdir('emails');
for (@files) {
    #...
}

您可能还想检查chdir的返回值。

或者自行添加目录名称：

rename('emails/' . $old, 'emails/' . $_) or print "Error renaming $old: $!\n";
# or rename("emails/$old", "emails/$_") if you like string interpolation
# or you could use map if you like map

你也许想要使用 grep 结合目录读取和过滤：

my @files = grep { /^RE .+msg$/ } readdir(DIR);

或者甚至是这个：

opendir(DIR, 'emails') or die "Cannot open directory";
for (grep { /^RE .+msg$/ } readdir(DIR)) {
    (my $new = $_) =~ s/^RE //;
    rename("emails/$_", "emails/$new") or print "Error renaming $_ to $new: $!\n";
}
closedir(DIR);

- mu is too short

Answer 2

您似乎假设的是类似于glob而不是readdir的行为。

底层的readdir系统调用仅返回目录中的文件名，并包括两个条目.和..。这也适用于Perl中的readdir函数，只是为了更详细地解释mu的答案。

另外，如果您无论如何都要在数组中收集所有结果，那么使用readdir没有太多意义。

@files = glob('emails/*');

- ephemient

---

+1 提醒我 glob 的存在。glob 的缺点是由于存在 'emails/' 前缀，它会使名称混淆变得有点复杂，但这是一个相当小的问题，很容易处理。 - mu is too short

Answer 3

如前所述，您的脚本失败是由于您期望的路径和脚本使用不同。

我建议更透明的用法。在我的看法中，硬编码目录不是一个好主意。有一天我制作了一个脚本来修改一些原始文件，并且使用了硬编码路径，我的一位同事认为这将是一个不错的脚本来借用以修改他的副本。哎呀！

用法：

perl script.pl "^RE " *.msg

即正则表达式，然后是文件glob列表，路径相对于脚本表示，例如*.msg，emails/*.msg甚至/home/pat/emails/*.msg /home/foo/*.msg（多个glob可能）。

使用绝对路径会让用户清楚地知道哪些文件将受到影响，并且这也使得脚本可重用。 代码：

use strict;
use warnings;
use v5.10;
use File::Copy qw(move);

my $rx = shift;   # e.g. "^RE "

if ($ENV{OS} =~ /^Windows/) {  # Patch for Windows' lack of shell globbing
    @ARGV = map glob, @ARGV;
}

for (@ARGV) {
    if (/$rx/) {
        my $new = s/$rx//r;  # Using non-destructive substitution
        say "Moving $_ to $new ...";
        move($_, $new) or die $!;
    }
}

- TLP

---

嗨，我真的很喜欢这个想法。但是在 my $new = s/$rx//r 这一行上似乎出现了错误。输出为“bareword found where operator expected near "s/$rx//r" and syntax error near the same”。 - Johnathan1

@JP。哦，那可能是因为你使用的 Perl 版本不同... 你用的是哪个版本？ - TLP

@JP。corelist "/r"告诉我，/r是在Perl v5.8.9中首次发布的，因此在早期版本中不可用非破坏性选项。 - TLP

@JP。那应该可以工作了。这段代码对我来说是有效的。你使用了“^RE”作为你的正则表达式吗？正则表达式中不应该有斜杠。要么如此，要么在复制/粘贴到你的端点时出现了一些错误。你可能需要检查一下你的版本是否支持/r和say。 - TLP

如果是 /r 选项，那么很容易解决。只需将该行替换为 my $new = $_; $new =~ s/$rx//; 即可。 - TLP

TLP，“corelist“/r””是错误的，因为它只接受模块名称。r修饰符首次出现在5.13.2中。 - daxim

Answer 4

我不确定正则表达式是否符合文件名的规范，但是可以用一行代码来完成：

perl -E'for (</path/to/emails*.*>){ ($new = $_) =~ s/(^RE)(.*$)/$2/; say $_." -> ".$new}

(say ... 对于测试很好用，只需将其替换为 rename $_,$new 或 rename($_,$new))

1. <*.*> 读取当前目录中的所有文件
2. ($new = $_) =~ 将以下替换保存在 $new 中，并保持 $_ 不变
3. (^RE) 将此匹配保存在 $1 中（可选），并仅匹配以“RE”开头的文件
4. (.*$) 将直到行末（$）的所有内容保存到 $2 中
5. 用 $2 中的字符串替换匹配

- MacMartin