Perl Archive :: Tar

the*_*eid 3 perl

我想用File :: Find存档所有txt文件,删除源文件并删除空目录.

我在使用'$ tar-> rename();'重命名文件时遇到了困难.因为我想从他们的完整路径名中删除它们并仅使用父目录/*.txt,但无论我尝试代码,只重命名一个文件.
我不知道执行'unlink'功能的适当位置在哪里.

谢谢.

use strict;
use warnings;
use Archive::Tar;
use File::Find;
use File::Basename;  

my $dir = "E:/";

my @files = ();

find(\&archive, $dir);      
sub archive {
    /\.txt$/ or return;
    my $fd = $File::Find::dir;
    my $fn = $File::Find::name; 
    my $folder = basename($fd);
    my $file = $_;

    push @files, $fn;

    my $tar = Archive::Tar->new();  
    $tar->add_files(@files);
    $tar->rename( $fn, $folder."\\".$file );
    $tar->write($fd.'.tar');

    unlink $fn; 
    finddepth(sub{rmdir},'.');
}
Run Code Online (Sandbox Code Playgroud)

iva*_*cho 6

您正在错误地使用File :: Find接口.该档案子大干快上找到的每个文件调用一次.您最终会在每次调用时创建一个新tar,向其中添加一个文件并将其写出来.

更正:您最终尝试添加以前找到的所有文件,但您已经取消了除最后一个之外的所有文件.

让我们以小步骤执行此操作 - 首先根据目录查找并分类所有.txt文件,然后将它们添加到相关的tar文件中,最后清理:

my $dir = "E:/";

my %txt_files = ();

find(\&classify, $dir);      
sub classify{
    /\.txt$/ or return;
    my $fd = $File::Find::dir;
    my $fn = $File::Find::name;

    push @{$txt_files{$fd}||=[]}, $fn;
}

foreach my $folder (keys %txt_dirs) {
    my @files = @{$txt_files{$folder}};
    my $foldername = basename($folder);

    my $tar = Archive::Tar->new();  
    $tar->add_files(@files);
    $tar->rename( $_, $foldername."/".basename($_))
        for @files;

    $tar->write($folder.'.tar');
}

# remove all the txt files we've found
unlink for map {@{$_}} values %txt_files;

# try to remove the directories that contained the txt files
eval {rmdir} for keys %txt_files;
Run Code Online (Sandbox Code Playgroud)