comment on

After seeing your request in the Chatterbox earlier this evening, I hacked (in the bloody horror movie sense) together something that appears to do what you are requesting (view the content of text2.txt, for example, from within foo.tar.gz contained in baz.tar.gz). I hope the code below can give you at least a starting point to work from.

#!/usr/bin/perl

use strict;
use warnings;

use Archive::Tar;
use Carp;
use Data::Dumper;
use English qw( -no_match_vars )
  ;    # Avoids regex performance penalty in perl >= 5.16
use Getopt::Long;
use IO::String;
use IO::Uncompress::Gunzip qw( gunzip $GunzipError );
use IO::Zlib;
use List::Util;

$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Sortkeys = 1;

$SIG{__DIE__} = sub { Carp->confess; };

$OUTPUT_AUTOFLUSH        = 1;         # $| = 1;
$OUTPUT_RECORD_SEPARATOR = qq{\n};    # $\ = qq{\n};

my @inner_filename;
my $middle_filename;
my $outer_filename;

my $_debug        = 0;
my $display_inner = 0;
my $list_inner    = 0;
my $list_outer    = 0;

GetOptions(
    'debug!' => \$_debug,
    'help'   => sub { &help; },

    'inner-filename|inner_filename=s' => \@inner_filename,
    'out-filename|outer-filename|out_filename|outer_filename=s'
      => \$outer_filename,

    'display-inner|display_inner' => \$display_inner,
    'list-outer|list_outer'       => \$list_outer,
    'list-inner|list_inner'       => \$list_inner,
);

@inner_filename = List::Util::uniq @inner_filename;

if ($_debug) {
    print Data::Dumper->Dump(
        [
            \$display_inner, \$list_inner,
            \$list_outer,    \$outer_filename,
        ],
        [
            qw( *display_inner *list_inner *list_outer *outer_filename
+ )
        ]
    );
}

# Archive::Tar->iter() takes a filename
my $outer_tar = Archive::Tar->iter($outer_filename);

print qq{Content of $outer_filename:} if ($list_outer);
while ( my $f = $outer_tar->() ) {
    print qq{    }, $f->name if ($list_outer);

    if ( $list_inner or $display_inner ) {
        if ( $f->name =~
            m/ \. (?: t (?: ar (?: \. gz )? | gz ) ) $/imsx )
        {
            my $inner_tar_data = $f->get_content;
            print q{    } x 1, q{Length: },
              length $inner_tar_data
              if ($list_outer);

            my $inner_tar_archive;
            my $io = IO::String->new($inner_tar_archive);
            my $gz_handle =
              new IO::Uncompress::Gunzip \$inner_tar_data
              or die $!;

            my $data_block;
            my $status = 1;
            while ( $status > 0 ) {
                $status = $gz_handle->read($data_block);
                if ( $status < 0 ) {
                    die qq{gunzip failed: $GunzipError};
                }
                if ( $status == 0 ) {

                    # EOF
                }
                $inner_tar_archive .= $data_block;
            }
            close $gz_handle;
            print qq{    } x 2, qq{Length (uncompressed): },
              length $inner_tar_archive
              if ($list_outer);

            $io->setpos(0);    # be kind - rewind
            my $inner_tar = Archive::Tar->new;
            $inner_tar->read($io) or die $!;

            foreach my $fn ( sort { $a cmp $b }
                $inner_tar->list_files )
            {
                print qq{    } x 3, qq{(}, $f->name,
                  q{) / } . $fn
                  if ($list_inner);
                my ($atf) = $inner_tar->get_files($fn);

                if ($display_inner) {
                    next
                      unless ( not scalar @inner_filename
                        or grep { /$fn/ } @inner_filename );

                    next if ( $atf->is_blockdev );
                    next if ( $atf->is_chardev );
                    next if ( $atf->is_dir );
                    next if ( $atf->is_fifo );

                    # next if ( $atf->is_file );
                    next if ( $atf->is_hardlink );
                    next if ( $atf->is_label );
                    next if ( $atf->is_longlink );
                    next if ( $atf->is_socket );
                    next if ( $atf->is_symlink );
                    next if ( $atf->is_unknown );

                    print qq{\n};
                    my $internal_data =
                      $inner_tar->get_content($fn);
                    print $internal_data;

                    print qq{\n};
                }
            }
        }
    }
}

sub help {
    print <<USAGE;

Usage:
    $0 [--help]
    $0 [--debug] \
        [--inner_filename=filename] \
        [--outer_filename=filename] \
        [--list_outer]              \
        [--list_inner]              \
        [--display_inner]

Required:
    --outer_filename    - Name of outer archive
    One or more of the following options:
        --list_outer    - display names of files in outer archive
        --list_inner    - display names of contained archives
        --display_inner - display content of files listed
                            given by --inner_filename
Optional:
    --inner_filename    - Name of internal archive to display
                            (can be specified multiple times)

USAGE

    exit;
}
[download]

Hope that helps.

In reply to Re: Reading tar.gz file recursively by atcroft
in thread Reading tar.gz file recursively by vinoth.ree

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


XP is just a number
	PerlMonks