#!/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;
}