重复文件名需要 Perl 脚本帮助

Question

我开发了以下 shell 脚本来查找文件名的重复部分并将其删除。同样，我也需要准备 Perl 脚本，因为 perl 脚本文本处理需要更少的时间。

#!/bin/bash
for i in `ls -t *xml|awk 'BEGIN{FS="_"}{if (++dup[$1] >= 2) print}'`;
do
rm $i
done 

我必须准备我的 perl 脚本我的代码，例如只有最近修改的文件名模式

File 1: AAA_555_0000 
File 2: AAAA_123_123 
File 3: AAAA_452_452 [latest]

File 4: BBB_555_0000 
File 5: BBB_555_555 
File 6: BBB_999_999 [latest]

File 7: CCC_555_0000 
File 8: CCC_000_000 
File 9: CCC_000_111 [latest]

Perl 脚本必须在文件夹中的所有文件名模式（意味着文件名的一部分）中选择最新的文件，并且它应该比较并删除重复项。 例如：脚本必须选择 AAA 文件名模式中的最新文件，如果模式发现它必须删除，它必须与其他 AAA 模式进行比较。最后，必须保留所有文件名模式中的最新文件。

如果你能帮助我理解这个逻辑，不胜感激。

非常感谢！

Answer 1

您的问题对我来说有点不清楚，因为我不确定您如何确定文件的顺序来判断哪个文件较新。这段代码会做我认为你需要的：

my $dir = shift || '.';

opendir(my $dh, $dir);
my @files = sort grep !/^\./, readdir($dh);

my $last;
my @batch;
foreach my $f (@files) {
  my @parts = split /_/, $f;

  if( !$last ) {
    $last = $parts[0];
    push @batch, [ @parts ];
  }
  elsif( index($last, $parts[0]) != -1 ) {
    push @batch, [ @parts ];
  }
  else {
    delete_files(@batch);

    @batch = ([ @parts ]);
    $last  = $parts[0];
  }
}
delete_files(@batch);

sub delete_files {
  my @batch = @_;

  @batch = sort {
    $a->[0] cmp $b->[0] ||
    $a->[1] cmp $b->[1] ||
    $a->[2] cmp $b->[2]
  } @batch;
  pop @batch;

  map { print "Delete: ", join('_', @$_), "\n"; } @batch;
}

它假定一个 batch 文件是其中文件具有相同前缀（直到第一个 '_' 字符）的文件。当两个前缀的长度不同时，公共长度必须匹配。

它还假设应该比较“版本号”（由“_”分隔的文本位），最左边的最有意义。

鉴于这些假设，指向包含您提到的文件的目录的代码输出：

# latest.pl <dir>
Delete: AAA_555_0000
Delete: AAAA_123_123
Delete: BBB_555_0000
Delete: BBB_555_555
Delete: CCC_000_000
Delete: CCC_000_111

不清楚的部分是为什么你认为文件 7 不是最新的......

订单明确后，可以换行：

map { print "Delete: ", join('_', @$_), "\n"; } @batch;

与：

map { unlink join('_', @$_); } @batch;

这样它就会删除文件。

您可以使用sub 中的排序算法，它决定了要删除哪些文件。现在它将文件名部分从左到右作为字符串进行比较。如有必要，您可以使用<=> 代替cmp 作为数字进行比较。