修改重复的删除脚本

Question

我有一个脚本，我们一直在使用维护来清除邮件服务器上的重复日历项目。我们发现的是，虽然它可以删除重复项目，但我们还需要删除原始项目。

该脚本由dups.pl . --killdups运行，然后它会报告哪些是原件的副本。

我不知道该怎么做是告诉脚本删除原来的。

由于我们显示哪个文件是重复文件，所以我们应该可以同时删除它。如果任何人都可以帮助我修改这一点，将不胜感激。

它是在for循环它找到复本，然后选择“取消链接”起来：

foreach $l (@l) { 
     @fields=split(/:--:/,$l,3); 
      if($last[0] eq $fields[0] && -f "$dir/$fields[2]" && -f "$dir/$last[2]") { 
      $dups++; 
      print "$dir/$fields[2] is a dup of $dir/$last[2]\n"; 
      if($verbose==1) { print " --- $fields[0]\n" } 
      if($killdups==1) { 
      print "Deleting $dir/$fields[2]\n"; 
       unlink "$dir/$fields[2]"; 
      } 

，我已经注意到的问题是，如果我选择了取消链接“$ DIR/$最后的[2 ]“在这个领域也是脚本有问题，因为它寻找的原始作为一种手段，以消除dups。任何人都知道一个快速的方法来修改它，以便我可以删除dups并在最后删除原始文件？

这里是在情况下，整个脚本，你需要它：

#!/usr/bin/perl 

# Usage: dups.pl [--killdups][--verbose] <path to directory> 

foreach $a (@ARGV) { 
    if($a=~/^--/) { 
     if ($a =~ /^--killdups/) { $killdups=1; } 
     if($a =~ /^--verbose/) { $verbose=1; } 
    } else { push (@dirs, $a) } 
} 


for $dir (@dirs) { 
    if(!opendir(D, $dir)) { 
    warn "$dir: $!"; 
    next; 
    } 

    $dir=~s/\/$//; 

    @l=(); 

    while ($f=readdir(D)) { 
     $key=""; 
     if($f =~ /\.eml$/) { 
      $key=readfile("$dir/$f"); 
     $mtime=(stat($f))[9]; 
     if($key ne "") { 
       push(@l, $_=sprintf "%s:--:%d:--:%s", $key, $mtime, $f); 
     } else { 
     print "$dir/$f: Not a VCARD?\n"; 
     } 
     } 
    } 
    closedir(D); 

    @l=sort(@l); 
    $dups=0; 
    $last[0]=$last[1]=$last[2]=""; 
    foreach $l (@l) { 
    @fields=split(/:--:/,$l,3); 
     if($last[0] eq $fields[0] && -f "$dir/$fields[2]" && -f "$dir/$last[2]") { 
     $dups++; 
     print "$dir/$fields[2] is a dup of $dir/$last[2]\n"; 
     if($verbose==1) { print " --- $fields[0]\n" } 
     if($killdups==1) { 
     print "Deleting $dir/$fields[2]\n"; 
      unlink "$dir/$fields[2]"; 
     } 
    } elsif ($last[0] eq $fields[0]) { 
     print "Strangeness -- $dir/$fields[2] dup of $dir/$last[2]??? -- [$fields[0]]\n"; 
     } else { 
     if($verbose==1) { 
      print "$dir/$fields[2] is UNIQUE\n"; 
      print "$fields[0]\n"; 
     } 
      @last=@fields; 
     } 
    } 
    if($killdups==1) { 
    print "$dups duplicates removed.\n"; 
    } else { 
    print "$dups duplicates detected.\n"; 
    } 
} 

sub readfile { 
    local($f)=@_; 
    local($k, $l, @l, $begin=0, $wrap, $xfa, $fn, $em, $start, $end, $sum, $org, $tel); 

    $wrap=$org=$xfa=$fn=$em=$start=$end=$sum=$tel=""; 

    open(F, $f) || warn "$f: $!\n"; 
    @l=<F>; 
    close F; 
    foreach $l (@l) { 
    if($l=~/^BEGIN:VTIMEZONE/) { $TZ=1 } 
    elsif($begin==0 && $l=~/^Subject:\s*(.*)\s*$/) { 
     $sum=$1; } 
    elsif($begin==0 && $l=~/^BEGIN:VCARD/) { $begin=1; } 
    elsif($begin==1 && $l=~/^END:VCARD/) { $begin=0; } 
    elsif($l=~/^END:VTIMEZONE/) { $TZ=0 } # Ability to skip the timezone section 
    elsif($TZ==0 && $begin==0 && $l=~/^BEGIN:VEVENT/) { $begin=1; } 
    elsif($TZ==0 && $begin==1 && $l=~/^BEGIN:VEVENT/) { print STDERR "$f: WTF?\n" } 
    if($begin==1) { 
     if($start eq "" && $l=~/^DTSTART.*[\;\:]([\dT]+)/) { 
      $start=$1; 
      $start=~s/^\s+|\s+$//g; 
      $start=~s/://g; 
     } elsif($start eq "" && $l=~/^DTSTART.*[^\d](\d+T\d+)/) { 
      $start=$1; 
      $start=~s/^\s+|\s+$//g; 
      $start=~s/://g; 
     } elsif($end eq "" && $l=~/^DTEND.*[^\d](\d+T\d+)/) { 
      $end=$1; 
      $end=~s/^\s+|\s+$//g; 
      $end=~s/://g; 
     goto DTEND; 
     } elsif($end eq "" && $l=~/^DTEND.*[\;\:]([\dT]+)/) { 
      $end=$1; 
      $end=~s/^\s+|\s+$//g; 
      $end=~s/://g; 
     goto DTEND; 
     } elsif($org eq "" && $l=~/^ORG:(.*)$/) { 
      $org=$1; 
      $org=~s/^\s+|\s+$//g; 
      $org=~s/://g; 
     $wrap="org"; 
     } elsif($sum eq "" && $l=~/^SUMMARY:(.*)$/) { 
      $sum=$1; 
      $sum=~s/^\s+|\s+$//g; 
      $sum=~s/://g; 
     } elsif(($wrap eq "tel" && $l=~/^([A-Z]*\;.*)/) || 
     ($tel eq "" && $l=~/^(TEL\;.*)$/)) { 
     $tel.=$1; 
      $tel=~s/^\s+|\s+$//g; 
      $tel=~s/^[\r\n]//g; 
      $tel=~s/://g; 
     $wrap="tel"; 
     } elsif(($wrap eq "org" && $l=~/^([A-Z]*\;.*)/) || 
     ($org eq "" && $l=~/^ORG:\s*(.*)\s*$/)) { 
     $org.=$1; 
      $org=~s/^\s+|\s+$//g; 
      $org=~s/^[\r\n]//g; 
      $org=~s/://g; 
     $wrap="org"; 
     } elsif(($wrap eq "fn" && $l=~/^([A-Z]*\;.*)/) || 
     ($fn eq "" && $l=~/^FN:\s*(.*)\s*$/)) { 
     $fn.=$1; 
      $fn=~s/^\s+|\s+$//g; 
      $fn=~s/^[\r\n]//g; 
      $fn=~s/://g; 
     $wrap="fn"; 
     } elsif(($wrap eq "em" && $l=~/^([A-Z]*\;.*)/) || 
     ($em eq "" && $l=~/^EMAIL[:;]\s*(.*)\s*$/)) { 
     $em.=$1; 
      $em=~s/^\s+|\s+$//g; 
      $em=~s/^[\r\n]//g; 
      $em=~s/://g; 
     $wrap="em"; 
     } elsif(($wrap eq "xfa" && $l=~/^([A-Z]*\;.*)/) || 
     ($xfa eq "" && $l=~/^X-FILE-AS:\s*(.*)\s*$/)) { 
     $xfa.=$1; 
      $xfa=~s/^\s+|\s+$//g; 
      $xfa=~s/^[\r\n]//g; 
      $xfa=~s/://g; 
     $wrap="xfa"; 
     } else { 
     $wrap=""; 
     } 
     } 
    } 
DTEND: 
    if(($start eq "" || $end eq "") && ($fn eq "" && $em eq "" && $sum eq "" && $org eq "" && $tel eq "")) { 
    if($verbose eq 1) { 
     print "$f: \$start == [$start]\n"; 
     print "$f: \$end == [$end]\n"; 
     print "$f: \$sum == [$sum]\n"; 
     print "$f: \$fn == [$fn]\n"; 
     print "$f: \$em == [$em]\n"; 
     print "$f: \$org == [$org]\n"; 
     print "$f: \$tel == [$tel]\n"; 
    } 
    return; 
    } 
    if($start ne "" || $end ne "") { 
     $k=$start."-".$end."-".$sum; 
    } else { 
    $k=$xfa."-".$fn."-".$em."-".$org."-".$tel; 
    } 
    return $k; 
} 

Answer 1

见此代码让我很高兴我没有去维护它。有一些具体的项目你应该解决之前，任何人在他的正确的思想应该考虑在此工作：

使用strict和warnings。

使用Getopt::Long作为命令行参数。

声明变量的最小适用范围而不是子例程的顶部。

作用域变量词法上使用my而不使用local。有关更多信息，请参阅Coping with scoping。

综观：

for $dir (@dirs) { 
    if(!opendir(D, $dir)) { 
    warn "$dir: $!"; 
    next; 
    } 

    $dir=~s/\/$//; 

你知道最后s///正在操作哪个目录？

同样，如果您在命令行上传递多个目录，则包全局句柄D中的值不明确。该程序的结构应该是：

use strict; use warnings; 
use File::Spec::Functions qw(catfile); 
use Getopt::Long; 

my %opt = (
    verbose => 0, 
    killdupes => 0, 
); 

GetOptions(\%opt, 'verbose', 'killdupes'); 

my %files; 

for my $dir (@ARGV) { 
    process_directory(\%files, $dir); 
} 

# do whatever you want with dupes in %files 

use YAML; 
print Dump \%files; 

sub process_directory { 
    my ($files, $dir) = @_; 

    my $dir_h; 

    unless (opendir $dir_h, $dir) { 
     warn "Failed to open directory '$dir': $!\n"; 
     return; 
    } 

    while (defined(my $file = readdir $dir_h)) { 
     my $path = catfile $dir, $file; 
     print "$path\n" if $opt{verbose}; 
     push @{ $files->{ keyof($file) } }, $path; 
    } 
} 

sub keyof { 
    return int(rand 2); 
} 

最后，它看起来像你解析/试图手动解析Vcard文件。 CPAN上有许多与Vcard相关的模块。

Answer 2

下面是我通过一堆目录搜索并删除重复文件的脚本。我主要用它来摆脱重复的数码照片。我浏览所有文件并记下他们的MD5摘要。我保留了与该摘要匹配的所有文件的散列。最后，我显示所有的模板，然后删除所有模板，但删除了我找到的第一个模板。

这只是一个快速和肮脏的脚本，但同样的过程可能适合你。

#!/usr/local/bin/perl 
use strict; 
use warnings; 

use Digest::MD5; 
use File::Spec::Functions; 

my @dirs = @ARGV; 
print "Dirs are @dirs\n"; 

my %digests; 
DIR: foreach my $dir (@dirs) 
    { 
    opendir my $dh, $dir or do { 
     warn "Skipping $dir: $!\n"; 
     next DIR; 
     }; 

    my @files = 
     map { catfile($dir, $_) } 
     grep { ! /^\./ } 
     readdir $dh; 

    FILE: foreach my $file (@files) 
     { 
     next if -d $file; 
     my $digest = md5_digest($file); 

     push @{ $digests{ $digest } }, $file; 
     } 
    } 

my $count = 0; 
foreach my $digest (keys %digests) 
    { 
    next unless @{ $digests{$digest} } > 1; 

    local $" = "\n"; # " 
    print "Digest: $digest\n@{ $digests{$digest} }\n------\n"; 

    $count++; 

    # unlink everything but the first one 
    unlink @{ $digests{$digest} }[1..$#{ $digests{$digest}] 
    } 

print "There were $count duplicated files\n"; 

sub md5_digest 
    { 
    my $file = shift; 

    open my($fh), '<', $file or do { 
     warn "cannot digest $file: $!"; 
     return; 
     }; 

    my $ctx = Digest::MD5->new; 

    $ctx->add(do { local $/; <$fh> }); 

    return $ctx->hexdigest; 
    }