如何在 Perl 中将部分子字符串更改为混合大小写

Question

Perl 重命名实用程序在日常文件工作中做得很好，尤其是在我不时检查我的 MP3 收藏时。

有些人有一个可怕的习惯，总是把艺术家的名字大写，就像这样

03 - ARTIST NAME - Song Title.mp3

我希望将它重命名为看起来更平静的混合大小写，像这样

03 - Artist Name - Song Title.mp3

但是，它也应该以一种智能的方式完成。

可能有法语或意大利语标题，例如：

05 - JEAN BAGUETTE - Honi soit qui mal y pense.mp3

或

07 - SIGNORE AL FORNO - Pazzi sono tutti i calciatori.mp3

因此，我确实不希望这些在- 之后更改为混合大小写，只有艺术家部分。

一种行不通的方法是

rename 's/(\d{1,2} - )([A-Z ]+)([\s\S]+)/$1lc($2)$3/' filename

无论如何我都会发布它，因为它总能让你更好地了解我想要做什么。

我还尝试用临时变量替换$2（因为我不允许更改$2，因为它是只读的）并在打印结果之前执行lc()，但我没有成功。但无论如何，我是一个 Perl 初学者。

Answer 1

您可以在您的正则表达式中使用 ucfirst (\u) 和 lc (\L) 的转义序列，并结合需要进一步向前冲刺的前瞻断言：

perl -pe 's/(\w)(\w+)(?=.*-)/\u$1\L$2/g'

如果要更正确，可以使用\pL（字母）代替\w。我认为这将适用于 rename 工具。

预计到达时间：已更新为使用 \u 而不是 \U。

Answer 2

我知道的最明确的方法是进行两阶段评估（使用/e 修饰符）替换。

在下面的代码中，外部替换选择艺术家姓名，包括其边界连字符并替换它。

内层采用$1 - 艺术家姓名 - 并将非空格字符的每个子序列替换为相同的字符串，首先小写为lc，然后大写为ucfirst。

就目前而言，程序将打印之前和之后的名称。从重命名行中删除 # 以进行重命名。

use strict;
use warnings;

my @data = (
  '05 - JEAN BAGUETTE - Honi soit qui mal y pense.mp3',
  '07 - SIGNORE AL FORNO - Pazzi sono tutti i calciatori.mp3',
);

for my $file (@data) {

  (my $new = $file) =~ s{(-[^-]+-)}{
    (my $artist = $1) =~ s/(\S+)/ucfirst lc $1/eg;
    $artist;
  }e;

  print "$file\n";
  print "$new\n";
  print "\n";
  # rename $file, $new;
}

输出

05 - JEAN BAGUETTE - Honi soit qui mal y pense.mp3
05 - Jean Baguette - Honi soit qui mal y pense.mp3

07 - SIGNORE AL FORNO - Pazzi sono tutti i calciatori.mp3
07 - Signore Al Forno - Pazzi sono tutti i calciatori.mp3

---

更新

您可能喜欢的另一种方法是在连字符上拆分文件名，编辑第二部分并将它们重新组合在一起。

上面的主循环变成了

for my $file (@data) {

  my @file = split /-/, $file;
  $file[1] =~ s/(\S+)/ucfirst lc $1/eg;
  my $new = join '-', @file;

  print "$file\n";
  print "$new\n";
  print "\n";
  # rename $file, $new;
}

功能和输出不变。

---

更新 2

我刚刚尝试使用 /-.*?-/ 然后使用 substr($_, $-[0], $+[0]) 作为 =~ s/// 的左值，但遗憾的是它不起作用

这似乎是个好主意，我不得不尝试一下。

您对substr 的调用是错误的，因为$-[0] 和$+[0] 是字符串的偏移量。 substr的第三个参数必须是字符串length所以需要写substr($_, $-[0], $+[0] - $-[0])

这段代码运行良好，并且再次产生与之前相同的结果

for my $file (@data) {

  next unless $file =~ /-[^-]+-/;
  my $new = $file;
  substr($new, $-[0], $+[0]-$-[0]) =~ s/(\S+)/ucfirst lc $1/eg;

  print "$file\n";
  print "$new\n";
  print "\n";
  # rename $file, $new;
}