How to add complete tree structure into a .tar.bz2 file with Perl?

Question

I am looking to compress a lot of data spread across loads of sub-directories into an archive. I cannot simply use built-in tar functions because I need my Perl script to work in a Windows as well as a Linux environment. I have found the Archive::Tar module but their documentation gives a warning:

Note that this method [create_archive()] does not write on the fly as it were; it still reads all the files into memory before writing out the archive. Consult the FAQ below if this is a problem.

Because of the sheer size of my data, I want to write 'on the fly'. But I cannot find useful information in the FAQ about writing files. They suggest to use the iterator iter():

Returns an iterator function that reads the tar file without loading it all in memory. Each time the function is called it will return the next file in the 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";
    # ....
}

But this only discusses the reading of files, not the writing of the compressed archive. So my question is, how can I take a directory $dir and recursively add it to an archive archive.tar.bz2 with bzip2 compression in a memory-friendly manner, i.e. without first loading the whole tree in memory?

I tried to build my own script with the suggestions in the comments using Archive::Tar::Streamed and IO::Compress::Bzip2, but to no avail.

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";

Very quickly, my system runs out of memory. I have 32GB available in my current system, but it gets flooded almost immediately. Some files in the directory I am trying to add to the archive exceed 32GB.

So I wonder if even in the Streamed class each file has to be read in memory completely before being added to the archive? I assumed the files themselves would be streamed in buffers to the archive, but perhaps it's simply that instead of first saving ALL files in memory, Streamed allows to only need one file in memory completely, and then adding that to the archive, one by one?

Answer 1

Unfortunately, what you want is not possible in Perl:

I agree, it would be nice if this module could write the files in chunks and then rewrite the headers afterwards (to maintain the relationship of Archive::Tar doing the writing). You could maybe walk the archive backwards knowing you split the file into N entries, remove the extra headers, and update the first header with the sum of their sizes.

At the moment the only options are: use Archive::Tar::File, split the data into manageable sizes outside of perl, or use the tar command directly (to use it from perl, there's a nice wrapper on CPAN: Archive::Tar::Wrapper).

I don't think we'll ever have a truly non-memory-resident tar implementation in Perl based on Archive::Tar. To be honest, Archive::Tar itself needs to be rewritten or succeeded by something else.

Answer 2

This is the original version of my solution, which still stores a whole file in memory. I probably shan't have time today to add an update which only stores partial files, as the Archive::Tar module doesn't have the friendliest 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";
}