从单个目录删除内容重复的文件[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++;
}

使用严格；
使用警告；
我的@files=；
我的$current=0；
而（$current主题的变体：

md5sum *.txt | perl -lne '
  my ($sum, $file) = split " ", $_, 2;
  unlink $file if $seen{$sum} ++;
'

不需要去保存一个列表，只需从列表中删除一个并删除其余的；只需跟踪您以前看到的内容，并删除与已看到的总和匹配的任何文件。2限制拆分是对包含空格的文件名做正确的处理

此外，如果您不信任此选项，只需将单词
unlink
更改为
print
，它将输出一个要删除的文件列表。您甚至可以将该输出转换为文件，然后
rm$（cat to delete.txt）
最后，如果它看起来不错。
您可能想看看我是如何找到重复文件并将其删除的。尽管您必须根据需要对其进行修改

这里有一个通用算法（为了提高效率，我已经摆脱了困倦——我还修复了一个没有人报告的bug）.：）

如果我将每个文件的内容与其他文件的内容进行比较，这将花费很长时间（更不用说大量内存）。相反，我们为什么不先对大小相同的文件应用相同的搜索，然后比较大小相同的文件的校验和呢

因此，当我们md5sum每个文件（请参阅）计算其大小时，我们可以使用哈希表为我们进行匹配，将匹配项存储在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)
}

现在，我们只需使用相同的散列技术取出潜在的重复项并检查它们是否相同（通过为每个重复项创建一个校验和，使用）：

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";
    }
}

while（我的（$size，$files）=每个%files\u按大小）
{
下一步如果@$files==1；
我的%files\u由\u md5；
foreach my$文件（@$files_by_md5）
{
使用Digest:：MD5模块打开我的$filehandle，'Perl

use Digest::MD5 ;
%seen = ();
while( <*> ){
    -d and next;
    $filename="$_"; 
    print "doing .. $filename\n";
    $md5 = getmd5($filename) ."\n";    
    if ( ! defined( $seen{$md5} ) ){
        $seen{$md5}="$filename";
    }else{
        print "Duplicate: $filename and $seen{$md5}\n";
    }
}
sub getmd5 {
    my $file = "$_";            
    open(FH,"<",$file) or die "Cannot open file: $!\n";
    binmode(FH);
    my $md5 = Digest::MD5->new;
    $md5->addfile(FH);
    close(FH);
    return $md5->hexdigest;
}

我建议您使用Perl，并在使用时使用它。

谁知道你在做什么来生成你的文件列表，但是你可能想把它和你的重复检查结合起来

perl -MFile::Find -MDigest::MD5 -e '
my %m;
find(sub{
  if(-f&&-r){
   open(F,"<",$File::Find::name);
   binmode F;
   $d=Digest::MD5->new->addfile(F);
   if(exists($m{$d->hexdigest}){
     $m{$d->hexdigest}[5]++;
     push $m{$d->hexdigest}[0], $File::Find::name;
   }else{
     $m{$d->hexdigest} = [[$File::Find::name],0,0,0,0,1];
   }
   close F
 }},".");
 foreach $d (keys %m) {
   if ($m{$d}[5] > 1) {
     print "Probable duplicates: ".join(" , ",$m{$d}[0])."\n\n";
   }
 }'

perl-MFile:：Find-MDigest:：MD5-e'
我的%m；
查找（子对象）{
如果（-f&&r）{
open（F），Perl在这方面有点过分：

md5sum * | sort | uniq -w 32 -D | cut -b 35- | tr '\n' '\0' | xargs -0 rm

（如果缺少某些实用程序或它们没有这些标志/功能，
安装GNU findutils和coreutils。）
在本例中，bash脚本比perl更具表现力：

md5sum * |sort -k1|uniq -w32 -d|cut -f2 -d' '|xargs rm

以下是一种先按大小过滤，再按
md5
校验和过滤的方法：

#!/usr/bin/perl

use strict; use warnings;

use Digest::MD5 qw( md5_hex );
use File::Slurp;
use File::Spec::Functions qw( catfile rel2abs );
use Getopt::Std;

my %opts;

getopt('de', \%opts);
$opts{d} = '.' unless defined $opts{d};
$opts{d} = rel2abs $opts{d};

warn sprintf "Checking %s\n", $opts{d};

my $files = get_same_size_files( \%opts );

$files = get_same_md5_files( $files );

for my $size ( keys %$files ) {
    for my $digest ( keys %{ $files->{$size}} ) {
        print "$digest ($size)\n";
        print "$_\n" for @{ $files->{$size}->{$digest} };
        print "\n";
    }
}

sub get_same_md5_files {
    my ($files) = @_;

    my %out;

    for my $size ( keys %$files ) {
        my %md5;
        for my $file ( @{ $files->{$size}} ) {
            my $contents = read_file $file, {binmode => ':raw'};
            push @{ $md5{ md5_hex($contents) } }, $file;
        }
        for my $k ( keys %md5 ) {
            delete $md5{$k} unless @{ $md5{$k} } > 1;
        }
        $out{$size} = \%md5 if keys %md5;
    }
    return \%out;
}

sub get_same_size_files {
    my ($opts) = @_;

    my $checker = defined($opts->{e})
                ? sub { scalar ($_[0] =~ /\.$opts->{e}\z/) }
                : sub { 1 };

    my %sizes;
    my @files = grep { $checker->($_) } read_dir $opts->{d};

    for my $file ( @files ) {
        my $path = catfile $opts->{d}, $file;
        next unless -f $path;

        my $size = (stat $path)[7];
        push @{ $sizes{$size} }, $path;
    }

    for my $k (keys %sizes) {
        delete $sizes{$k} unless @{ $sizes{$k} } > 1;
    }

    return \%sizes;
}

这正是我避免使用shell脚本和Perl并用棍子戳它们的原因。这实际上是做了预期的任务，还是等同于“CD/> RM -R*”？这个世界永远都不会知道！（只是在滑稽。虽然下一次，考虑评论你的脚本）它完成了预期的任务。算法是构建列表的哈希。每个哈希键都是一个md5sum，列表中的元素都是具有该md5sum的文件。然后，删除每个列表的第一个元素，其余元素都是要删除的候选元素。如果需要该脚本的注释，请立即关闭终端窗口，永远不要删除pe在另一个程序中。我认为如果原始文件名中有空格，则此操作可能会失败。要解决此问题，请使用
split”“$\u2
，其中2会停止多次拆分（分成两部分）。我会统计文件的大小，只有在大小相同的情况下才检查md5总和。这很好，但会使工作组织更加困难--在找到大小相同的文件#37之前，您不知道需要对文件#3进行md5sum：）是否这样做取决于文件的大小。通常，如果我要查找重复的文件，它是在大型图像文件中，其中md5位将非常慢。对于像程序文件这样的文本文件，它不太可能是一个大问题，所以简单化的代码是可以的。我已经编辑了代码，首先检查文件大小（并修复了一个没有人发现的错误）：）以太，谢谢你的解决方案！这段代码仍然有几个问题：@$files{$md5}应该是@$files，@$files_按大小{-s$file}和@$files_按大小{-s$file}需要额外的卷发-{$files_按大小{-s$file}-否则它就不起作用了，至少在Win32上的Perl v5.10.1中是这样。虽然逻辑看起来不错。但这更具可扩展性，并且支持更多的工作。这是泛化带来的一种负担。而且，工作已经完成，您只需在大多数情况下下载并运行它。谁提出索赔，已经提到了源代码，我放在我的网站上，因为有一些轻微的修改。使用一个diff工具。没有人对多个目录中的文件说任何话，因此File:：Find不太可能有用。在xargs之前粘贴一个tr'\n''\0'，在xargs上使用-0标志以避免文件名中出现问题字符…| cut-b 35-|tr'\n'\0'| xargs-0rm@rjp：虽然我不知道如何处理文件名中的\n…我希望所有的coreutils都是-0。我想，你真的必须这样折腾一下（祈祷所有重复文件的文件名中都没有^A、[：：RET:]或[：：NL:：]或[：：NL:：]找到。-键入f-print0 | xargs-0 md5sum | sed-e's/\\n/[：NL:]/g'-e's/^M/[：RET:]/g'-e's/^\\\/'| sort | uniq-w32-D | cut-b35-| tr'\n'\0'| sed-e's/\[：：RET:::\]/^M/g'-e's/\[：：NL:\]/^A/g'|tr'\001'\n'|xargs-0-n1rmfor
sha1sum
，使用
uniq-w40-D
和
cut-b43-
。这会不会在文件名上用空格或其他有趣的字符中断？uniq-D，而不是-D.-D对于每个副本只输出一行，因此如果三个文件具有相同的内容，则只输出一行deleted@ysth：y
md5sum * |sort -k1|uniq -w32 -d|cut -f2 -d' '|xargs rm

#!/usr/bin/perl

use strict; use warnings;

use Digest::MD5 qw( md5_hex );
use File::Slurp;
use File::Spec::Functions qw( catfile rel2abs );
use Getopt::Std;

my %opts;

getopt('de', \%opts);
$opts{d} = '.' unless defined $opts{d};
$opts{d} = rel2abs $opts{d};

warn sprintf "Checking %s\n", $opts{d};

my $files = get_same_size_files( \%opts );

$files = get_same_md5_files( $files );

for my $size ( keys %$files ) {
    for my $digest ( keys %{ $files->{$size}} ) {
        print "$digest ($size)\n";
        print "$_\n" for @{ $files->{$size}->{$digest} };
        print "\n";
    }
}

sub get_same_md5_files {
    my ($files) = @_;

    my %out;

    for my $size ( keys %$files ) {
        my %md5;
        for my $file ( @{ $files->{$size}} ) {
            my $contents = read_file $file, {binmode => ':raw'};
            push @{ $md5{ md5_hex($contents) } }, $file;
        }
        for my $k ( keys %md5 ) {
            delete $md5{$k} unless @{ $md5{$k} } > 1;
        }
        $out{$size} = \%md5 if keys %md5;
    }
    return \%out;
}

sub get_same_size_files {
    my ($opts) = @_;

    my $checker = defined($opts->{e})
                ? sub { scalar ($_[0] =~ /\.$opts->{e}\z/) }
                : sub { 1 };

    my %sizes;
    my @files = grep { $checker->($_) } read_dir $opts->{d};

    for my $file ( @files ) {
        my $path = catfile $opts->{d}, $file;
        next unless -f $path;

        my $size = (stat $path)[7];
        push @{ $sizes{$size} }, $path;
    }

    for my $k (keys %sizes) {
        delete $sizes{$k} unless @{ $sizes{$k} } > 1;
    }

    return \%sizes;
}