The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;

use Getopt::Std;
use Archive::Tar;
use File::Find;

my $opts = {};
getopts('dcvzthxf:', $opts) or die usage();

### show the help message ###
die usage() if $opts->{h};

### enable debugging (undocumented feature)
local $Archive::Tar::DEBUG = 1 if $opts->{d};

### sanity checks ###
unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
    die "You need exactly one of 'x', 't' or 'c' options: " . usage();
}

my $compress    = $opts->{z} ? 1 : 0;
my $verbose     = $opts->{v} ? 1 : 0;
my $file        = $opts->{f} ? $opts->{f} : 'default.tar';
my $tar         = Archive::Tar->new();

if( $opts->{c} ) {
    my @files;
    find( sub { push @files, $File::Find::name;
                print $File::Find::name.$/ if $verbose }, @ARGV );
                
    Archive::Tar->create_archive( $file, $compress, @files );              
    exit;
} 

my $tar = Archive::Tar->new($file, $compress);

if( $opts->{t} ) {
    print map { $_->full_path . $/ } $tar->get_files; 

} elsif( $opts->{x} ) {    
    print map { $_->full_path . $/ } $tar->get_files
        if $verbose;
    Archive::Tar->extract_archive($file, $compress);
}    



sub usage {
    qq[
Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...      
        ptar -x [-v] [-z] [-f ARCHIVE_FILE] 
        ptar -t [-z] [-f ARCHIVE_FILE] 
        ptar -h
    
    ptar is a small, tar look-alike program that uses the perl module
    Archive::Tar to extract, create and list tar archives.    
    
Options:
    x   Extract from ARCHIVE_FILE
    c   Create ARCHIVE_FILE from FILE
    t   List the contents of ARCHIVE_FILE
    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
    v   Print filenames as they are added or extraced from ARCHIVE_FILE
    h   Prints this help message

See Also:
    tar(1)
    Archive::Tar

    \n]
}