0

我希望将分布在大量子目录中的大量数据压缩到存档中。我不能简单地使用内置的 tar 函数，因为我需要我的 Perl 脚本在 Windows 和 Linux 环境中工作。我找到了该Archive::Tar模块，但他们的文档给出了警告：

请注意，此方法 [ create_archive()] 不会on the fly 按原样写入；在写出存档之前，它仍然会将所有文件读入内存。如果这是一个问题，请参阅下面的常见问题解答。

由于我的数据量很大，我想“即时”写。但我在常见问题解答中找不到有关写入文件的有用信息。他们建议使用迭代器iter()：

返回一个迭代器函数，该函数读取 tar 文件而不将其全部加载到内存中。每次调用该函数时，它都会返回 tarball 中的下一个文件。

my $next = Archive::Tar->iter( "example.tar.gz", 1, {filter => qr/\.pm$/} );
while( my $f = $next->() ) {
    print $f->name, "\n";
    $f->extract or warn "Extraction failed";
    # ....
}

但这仅讨论文件的读取，而不是压缩存档的写入。所以我的问题是，如何获取一个目录并以内存友好的方式$dir将其递归地添加到使用 bzip2 压缩的存档中，即无需先将整个树加载到内存中？archive.tar.bz2

Archive::Tar::Streamed我尝试使用and使用评论中的建议构建自己的脚本IO::Compress::Bzip2，但无济于事。

use strict;
use warnings;

use Archive::Tar::Streamed;
use File::Spec qw(catfile);
use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error);

my ($in_d, $out_tar, $out_bz2) = @ARGV;

open(my $out_fh,'>', $out_tar) or die "Couldn't create archive";
binmode $out_fh;

my $tar = Archive::Tar::Streamed->new($out_fh);

opendir(my $in_dh, $in_d) or die "Could not opendir '$in_d': $!";
while (my $in_f = readdir $in_dh) {
  next unless ($in_f =~ /\.xml$/);
  print STDOUT "Processing $in_f\r";
  $in_f = File::Spec->catfile($in_d, $in_f);
  $tar->add($in_f);
}

print STDOUT "\nBzip'ing $out_tar\r";

 bzip2 $out_tar => $out_bz2
    or die "Bzip2 failed: $Bzip2Error\n";

很快，我的系统内存不足。我当前的系统中有 32GB 可用空间，但它几乎立即被淹没。我尝试添加到存档的目录中的某些文件超过 32GB。

超出内存

所以我想知道即使在Streamed课堂上每个文件都必须在添加到存档之前完全在内存中读取？我假设文件本身将在缓冲区中流式传输到存档，但也许只是不是首先将所有文件保存在内存中，而是Streamed允许完全只需要内存中的一个文件，然后将其逐个添加到存档中？

4

2 回答 2

1

不幸的是，你想要的在 Perl 中是不可能的：

我同意，如果这个模块可以将文件分块写入，然后重写标题（以维护 Archive::Tar 的关系），那就太好了。您可能知道您将文件拆分为N条目，删除额外的标题，并使用它们的大小总和更新第一个标题，您可能会向后走存档。

目前唯一的选择是：使用Archive::Tar::File，将数据拆分为可管理的大小perl，或者tar直接使用命令（要从 使用它perl，CPAN 上有一个很好的包装器：）Archive::Tar::Wrapper。

我认为我们永远不会tar在 Perl 中基于Archive::Tar. 老实说，Archive::Tar它本身需要被改写或被其他东西取代。

于 2017-07-30T16:54:35.147 回答
1

这是我的解决方案的原始版本，它仍然将整个文件存储在内存中。我今天可能没有时间添加仅存储部分文件的更新，因为该Archive::Tar模块没有最友好的 API

use strict;
use warnings 'all';
use autodie; # Remove need for checks on IO calls

use File::Find 'find';
use Archive::Tar::Streamed ();
use Compress::Raw::Bzip2;
use Time::HiRes qw/ gettimeofday tv_interval /;

# Set a default root directory for testing
#
BEGIN {
    our @ARGV;
    @ARGV = 'E:\test' unless @ARGV;
}

use constant ROOT_DIR => shift;

use constant KB => 1024;
use constant MB => KB * KB;
use constant GB => MB * KB;

STDOUT->autoflush; # Make sure console output isn't buffered

my $t0 = [ gettimeofday ];

# Create a pipe, and fork a child that will build a tar archive
# from the files and pass the result to the pipe as it is built
#
# The parent reads from the pipe and passes each chunk to the
# module for compression. The result of zipping each block is
# written directly to the bzip2 file
#
pipe( my $pipe_from_tar, my $pipe_to_parent );  # Make our pipe
my $pid  = fork;                      # fork the process

if ( $pid == 0 ) {    # child builds tar and writes it to the pipe

    $pipe_from_tar->close;    # Close the parent side of the pipe
    $pipe_to_parent->binmode;
    $pipe_to_parent->autoflush; 

    # Create the ATS object, specifiying that the tarred output
    # will be passed straight to the pipe
    #
    my $tar = Archive::Tar::Streamed->new( $pipe_to_parent );

    find(sub {

        my $file = File::Spec->canonpath( $File::Find::name );
        $tar->add( $file );

        print "Processing $file\n" if -d;

    }, ROOT_DIR );

    $tar->writeeof; # This is undocumented but essential

    $pipe_to_parent->close;
}
else {    # parent reads the tarred data, bzips it, and writes it to the file

    $pipe_to_parent->close; # Close the child side of the pipe
    $pipe_from_tar->binmode;

    open my $bz2_fh, '>:raw', 'T:\test.tar.bz2';
    $bz2_fh->autoflush;

    # The first parameter *must* have a value of zero. The default
    # is to accumulate each zipped chunnk into the output variable,
    # whereas we want to write each chunk to a file
    #
    my ( $bz, $status ) = Compress::Raw::Bzip2->new( 0 );
    defined $bz or die "Cannot create bunzip2 object: $status\n";

    my $zipped;

    while ( my $len = read $pipe_from_tar, my $buff, 8 * MB ) {

        $status = $bz->bzdeflate( $buff, $zipped );
        $bz2_fh->print( $zipped ) if length $zipped;
    }

    $pipe_from_tar->close;

    $status = $bz->bzclose( $zipped );
    $bz2_fh->print( $zipped ) if length $zipped;

    $bz2_fh->close;

    my $elapsed = tv_interval( $t0 );

    printf "\nProcessing took %s\n", hms($elapsed);
}


use constant MINUTE => 60;
use constant HOUR   => MINUTE * 60;

sub hms {
    my ($s) = @_;

    my @ret;

    if ( $s > HOUR ) {
        my $h = int($s / HOUR);
        $s -= $h * HOUR;
        push @ret, "${h}h";
    }

    if ( $s > MINUTE or @ret ) {
        my $m = int($s / MINUTE);
        $s -= $m * MINUTE;
        push @ret, "${m}m";
    }

    push @ret, sprintf "%.1fs", $s;

    "@ret";
}
于 2017-07-31T14:51:01.297 回答