#!/usr/bin/perl -w
# Most of this code is shamelessly stolen from Archive::Tar. Thanks.
#
# The copyright for the rest is as follows: 
#
# Copyright: (C) 2004 Marc Brockschmidt <marc@dch-faq.de>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.

use strict;
use Archive::Tar;
use constant HEAD           => 512;
use constant TAR_END        => "\0" x 512;
use constant BLOCK_SIZE     => sub { my $n = int($_[0]/512); $n++ if $_[0] % 512; $n * 512 };

my ($chunk, $real_name, $data);
while( read( STDIN, $chunk, HEAD ) ) {                  
    ### if we can't read in all bytes... ###
    last if length $chunk != HEAD;
    
    # Apparently this should really be two blocks of 512 zeroes,
    # but GNU tar sometimes gets it wrong. See comment in the
    # source code (tar.c) to GNU cpio.
    last if $chunk eq TAR_END; 
    
    my $entry; 
    unless( $entry = Archive::Tar::File->_new_from_chunk( $chunk ) ) {
        warn ( qq[Couldnt read chunk '$chunk'] );
        next;
    }
    
    ### ignore labels:
    ### http://www.gnu.org/manual/tar/html_node/tar_139.html
    next if $entry->is_label;
    
    if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) {      
        ### part II of the @LongLink munging -- need to do /after/
        ### the checksum check.

        my $block = BLOCK_SIZE->( $entry->size );

        $data = $entry->get_content_by_ref;
        
        ### just read everything into memory 
        ### can't do lazy loading since IO::Zlib doesn't support 'seek'
        ### this is because Compress::Zlib doesn't support it =/            
        if( read( STDIN, $$data, $block ) < $block ) {
            die ( qq[Read error on tarfile ]. $entry->name ."'" );
        }

        ### throw away trailing garbage ###
        substr ($$data, $entry->size) = "";
    }
    
    
    ### clean up of the entries.. posix tar /apparently/ has some
    ### weird 'feature' that allows for filenames > 255 characters
    ### they'll put a header in with as name '././@LongLink' and the
    ### contents will be the name of the /next/ file in the archive
    ### pretty crappy and kludgy if you ask me
    
    ### set the name for the next entry if this is a @LongLink;
    ### this is one ugly hack =/ but needed for direct extraction
    if( $entry->is_longlink ) {
        $real_name = $data;	
        next;
    } elsif ( defined $real_name ) {
        $entry->name( $$real_name );
        undef $real_name;
    }

	my $raw = $entry->raw();
	my $name = substr($raw, 0, 100);
	$name =~ s/\x00/-/g;

	print $name, "\n" if ((length($name) == 100) && ($name eq $entry->name()));
    
    ### Guard against tarfiles with garbage at the end
    last if $entry->name eq ''; 
} continue {
    undef $data;
}

exit;