修改复制删除脚本

Question

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

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

我不知道该怎么做是告诉脚本删除原始文件。

由于我们显示哪个文件是双重文件，因此我们应该能够同时删除它。如果有人可以帮我修改，我们将不胜感激。

它在for循环中找到了dup，然后“取消链接”它们：

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 / $ last [2]”，则脚本会出现问题，因为它会查找原始文件作为删除重复项的方法。任何人，知道一个快速的方法来修改这个，以便我可以删除重复并删除最终的原始文件？

以下是您需要的整个脚本：

#!/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;
    }