Как добавить полную древовидную структуру в файл.tar.bz2 с помощью Perl?

Question

Я хочу сжать много данных, распределенных по множеству подкаталогов в архив. Я не могу просто использовать встроенные функции tar, потому что мне нужен мой Perl-скрипт для работы как в среде Windows, так и в среде Linux. Я нашел Archive::Tar модуль, но их документация выдает предупреждение:

Обратите внимание, что этот метод [create_archive()] не пишет on the fly как было; он все еще читает все файлы в память, прежде чем записывать архив. Обратитесь к FAQ ниже, если это проблема.

Из-за огромного размера моих данных я хочу писать "на лету". Но я не могу найти полезную информацию в FAQ о написании файлов. Они предлагают использовать итератор iter():

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

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 и рекурсивно добавить его в архив archive.tar.bz2 с сжатием bzip2 в памяти, т.е. без предварительной загрузки всего дерева в память?

Я попытался создать свой собственный сценарий с предложениями в комментариях, используя Archive::Tar::Streamed а также 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";

Очень быстро моей системе не хватает памяти. В моей нынешней системе доступно 32 ГБ, но она почти сразу же залила. Некоторые файлы в каталоге, который я пытаюсь добавить в архив, превышают 32 ГБ.

Так что мне интересно, если даже в Streamed класс каждый файл должен быть полностью прочитан в памяти перед добавлением в архив? Я предполагал, что сами файлы будут передаваться в буферы в архив, но, возможно, просто вместо того, чтобы сначала сохранить ВСЕ файлы в памяти, Streamed позволяет полностью хранить только один файл в памяти, а затем добавлять его в архив один за другим?

Answer 1

К сожалению, то, что вы хотите , не возможно в Perl:

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

На данный момент единственными вариантами являются: использование Archive::Tar::Fileразделить данные на управляемые размеры за пределами perlили используйте tar команда напрямую (использовать его из perlесть хорошая оболочка на CPAN: Archive::Tar::Wrapper).

Я не думаю, что у нас когда-нибудь будет действительно не резидент памяти tar реализация в Perl на основе Archive::Tar, Если честно, Archive::Tar сам должен быть переписан или заменен чем-то другим.

Answer 2

Это оригинальная версия моего решения, которая до сих пор хранит весь файл в памяти. Я, вероятно, не успею сегодня добавить обновление, которое хранит только частичные файлы, так как 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";
}