Как я могу рекурсивно скопировать каталог и отфильтровать имена файлов в Perl? - PullRequest
Новая
       40

Как я могу рекурсивно скопировать каталог и отфильтровать имена файлов в Perl?

12 голосов
/ 23 октября 2008

Как скопировать каталог, включающий подкаталоги, за исключением файлов или каталогов, которые соответствуют определенному регулярному выражению в системе Windows?

Ответы [ 5 ]

11 голосов
/ 23 октября 2008

Я бы сделал что-то вроде этого: 

use File::Copy;
sub copy_recursively {
    my ($from_dir, $to_dir, $regex) = @_;
    opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
    for my $entry (readdir $dh) {
        next if $entry =~ /$regex/;
        my $source = "$from_dir/$entry";
        my $destination = "$to_dir/$entry";
        if (-d $source) {
            mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
            copy_recursively($source, $destination, $regex);
        } else {
            copy($source, $destination) or die "copy failed: $!";
        }
    }
    closedir $dh;
    return;
}
9 голосов
/ 23 октября 2008

Другим вариантом является File :: Xcopy. Как следует из названия, он более или менее эмулирует команду windows xcopy, включая параметры фильтрации и рекурсии.

Из документации: 

    use File::Xcopy;

    my $fx = new File::Xcopy; 
    $fx->from_dir("/from/dir");
    $fx->to_dir("/to/dir");
    $fx->fn_pat('(\.pl|\.txt)$');  # files with pl & txt extensions
    $fx->param('s',1);             # search recursively to sub dirs
    $fx->param('verbose',1);       # search recursively to sub dirs
    $fx->param('log_file','/my/log/file.log');
    my ($sr, $rr) = $fx->get_stat; 
    $fx->xcopy;                    # or
    $fx->execute('copy'); 

    # the same with short name
    $fx->xcp("from_dir", "to_dir", "file_name_pattern");
5 голосов
/ 23 октября 2008

Если вы оказались в Unix-подобной ОС и имеете доступ к rsync (1), вы должны использовать это (например, через system()).

Файл Perl File :: Copy немного сломан (например, он не копирует разрешения в системах Unix), поэтому, если вы не хотите использовать системные инструменты, посмотрите на CPAN. Может быть, File :: Copy :: Recursive может быть полезным, но я не вижу никаких опций исключения. Я надеюсь, что у кого-то есть идея получше.

1 голос
/ 23 октября 2008

Классический ответ будет использовать 'cpio -p': 

(cd $SOURCE_DIR; find . -type f -print) |
perl -ne 'print unless m/<regex-goes-here>/' |
cpio -pd $TARGET_DIR

Команда 'cpio' имеет дело с фактическим копированием, включая сохранение разрешений. Уловка 'cd $SOURCE_DIR; find . ...' связана с удалением ведущей части исходного пути из имен. Единственная проблема с этим вызовом 'find' заключается в том, что он не будет следовать символическим ссылкам; вам нужно добавить '-follow', если вы этого хотите.

1 голос
/ 23 октября 2008

Я не знаю, как сделать исключение с копией, но вы могли бы поработать что-то вроде: 

ls -R1 | grep -v <regex to exclude> | awk '{printf("cp %s /destination/path",$1)}' | /bin/sh
...