Модификация для дублирования скрипта удаления

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 / $ 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

Вот мой скрипт, который просматривает кучу каталогов и удаляет дубликаты файлов.Я в основном использую его, чтобы избавиться от дублированных цифровых фотографий.Я просматриваю все файлы и отмечаю их дайджест MD5.Я хэш всех файлов, соответствующих этому дайджесту.В конце я отображаю все дубликаты, затем удаляю все, кроме первого, который нашел.

Это просто быстрый и грязный скрипт, но тот же процесс может работать для вас.

Answer 2

Видя этот код, я рад, что мне не нужно его поддерживать. Есть ряд конкретных вопросов, которые вы должны рассмотреть, прежде чем кто-то в здравом уме должен подумать над этим:

Используйте строгие и предупреждения .

Используйте Getopt :: Long для аргументов командной строки.

Объявляйте переменные в наименьшей применимой области видимости вместо в верхней части подпрограммы.

Переменные области видимости лексически используют my и не используют local . Для получения дополнительной информации см. Как справиться с областью действия .

Глядя на:

    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.