perl - 从单个目录中删除具有重复内容的文件 [Perl 或算法]

标签 perl

我有一个包含大量文件的文件夹,其中一些文件的内容完全相同。我想删除具有重复内容的文件,这意味着如果找到两个或多个具有重复内容的文件,我想保留其中一个文件,并删除其他文件。

以下是我想出的,但我不知道它是否有效:),还没有尝试过。

你会怎么做? Perl 或通用算法。

use strict;
use warnings;

my @files = <"./files/*.txt">;

my $current = 0;

while( $current <= $#files ) {

    # read contents of $files[$current] into $contents1 scalar

    my $compareTo = $current + 1;
    while( $compareTo <= $#files ) {

        # read contents of $files[compareTo] into $contents2 scalar

        if( $contents1 eq $contents2 ) {
            splice(@files, $compareTo, 1);
            # delete $files[compareTo] here
        }
        else {
            $compareTo++;
        }
    }

    $current++;
}

最佳答案

这是一个通用算法(为了提高效率而进行了编辑,因为我已经摆脱了困倦——而且我还修复了一个没有人报告的错误)...... :)

如果我将每个文件的内容相互比较,这将需要很长时间(更不用说大量内存了)。相反,我们为什么不先对它们的大小应用相同的搜索,然后比较那些大小相同的文件的校验和。

因此,当我们 md5sum 每个文件(参见 Digest::MD5 )计算它们的大小时,我们可以使用哈希表为我们进行匹配,将匹配项一起存储在 arrayrefs 中:

use strict;
use warnings;
use Digest::MD5 qw(md5_hex);

my %files_by_size;
foreach my $file (@ARGV)
{
    push @{$files_by_size{-s $file}}, $file;   # store filename in the bucket for this file size (in bytes)
}

现在我们只需要提取潜在的重复项并检查它们是否相同(通过为每个重复项创建一个校验和,使用 Digest::MD5 ),使用相同的散列技术:
while (my ($size, $files) = each %files_by_size)
{
    next if @$files == 1;

    my %files_by_md5;
    foreach my $file (@$files_by_md5)
    {
        open my $filehandle, '<', $file or die "Can't open $file: $!";
        # enable slurp mode
        local $/;
        my $data = <$filehandle>;
        close $filehandle;

        my $md5 = md5_hex($data);
        push @{$files_by_md5{$md5}}, $file;       # store filename in the bucket for this MD5
    }

    while (my ($md5, $files) = each %files_by_md5)
    {
        next if @$files == 1;
        print "These files are equal: " . join(", ", @$files) . "\n";
    }
}

-fini

关于perl - 从单个目录中删除具有重复内容的文件 [Perl 或算法],我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/1747074/

相关文章:

perl - Perl 5.8 与 5.10 和 5.12 的子例程中的代码延迟评估有什么区别?

linux - BASH - 我如何从整个目录中搜索一个值并找到一些匹配的值,然后通过保存它来即时替换该行

Perl 执行/忽略代码的方式(如 C 中的断言)

arrays - 可以在不先声明变量的情况下进行引用吗?

perl - 如何使用 Lwp::Useragent 发送 http 补丁请求?

php - perl Spreadsheet::WriteExcel 是否比 PHPExcel 更快且占用内存更少?

sqlcmd : Error: Microsoft ODBC Driver 11 for SQL Server : Login failed for user 'sa'

regex - 使用 sed/perl 式正则表达式或 awk 展平嵌套列表模式

mysql - 在进程中间从脚本中释放内存

perl - 从 perl 脚本中以不同的用户身份调用另一个脚本