#!/usr/bin/perl
#
# untar.pl
#   Untar things without making a mess.  If the contents of the tar
#   are not all in one directory, one will be made and everything will
#   be untar'd in there.  (And you can specify multiple tarfiles)
#
# Written by Seth Golub <seth@aigeek.com> 
#            http://www.aigeek.com/
#
# v0.8
#

$verbose = "";

$max_eval  = 0;  # The default

while (@ARGV[0] =~ /^-.+/)
{
    if (@ARGV[0] eq "-v" ||  @ARGV[0] eq "--verbose")
    {
	$verbose = "v";
	shift @ARGV;
	next;
    }

    if ((@ARGV[0] eq "-m" || @ARGV[0] eq "--maxeval") &&
	@ARGV[1] =~ /^\d+$/)
    {
	$max_eval = @ARGV[1];
	shift @ARGV; shift @ARGV;
	next;
    }

    if (@ARGV[0] eq "-a" || @ARGV[0] eq "--absolute")
    {
	$allow_absolute_paths = 1;
	shift @ARGV; shift @ARGV;
	next;
    }
    &usage();
}
    
&usage if($ARGV[0] eq "");

sub usage
{
    $0 =~ s@^.*/([^/]+)$@$1@;
    print "
Usage:
  $0 [options] <filespec>

where options include:

  -v     | --verbose          - List files as they are untar'd.
  -m <#> | --maxeval <#>      - Only check first <#> files in each tar
                                file for conformance.  0 means check
                                the whole tar file.
  -a     | --absolute         - Allow absolute paths

";
    exit;
}

sub test_tar
{
#    local($tarfile) = @_;

#    die "Wildcards not allowed in filename.\n" if $tarfile =~ /[\*\?]/;

    do { print "Can't find $tarfile.\n"; return 0;} unless -e $tarfile;
    do { print "$tarfile unreadable.\n"; return 0;} unless -r $tarfile;
    1;
}

sub tar_cmd
{
    local($tarfile, $switches) = @_;

    if($tarfile =~ /\.(gz|Z|tgz|taz)$/)
    {
	"zcat $tarfile | tar -${switches}f -";
    } elsif ($tarfile =~ /\.bz2$/)
    {
	"bunzip2 -c $tarfile | tar -${switches}f -";
    } else {
	"tar -${switches}f $tarfile";
    }
}

# returns 1 if it doesn't make its own dir
# returns 2 if it's an absolute path
sub evaluate
{
#    local($tarfile) = @_;
    local($tarcmd) = (&tar_cmd($tarfile, "tv"));

    open(TAR, "$tarcmd |");

    $_ = <TAR>;

    if (!$allow_absolute_paths)
    {
        return 2 if m@ /\S*\s*(symbolic link to .*)?$@;
    }
    ($dirname) = m@\s([^\s/]+)/\S*\s*(symbolic link to .*)?$@;

    return 1 if $dirname eq "";
    print STDERR "$dirname\n";

    if($dirname eq ".")
    {
	return 1;
    }

    local($eval) = ($max_eval-1);
    while(($_ = <TAR>) && (!max_eval || $eval--))
    {
        return 1 if !((m@\s([^\s/]+)/\S+\s*(symbolic link to .*)?(-> .*)?$@) &&
                      ($1 eq $dirname) );
    }
    close(TAR);

    0;
}

sub make_dirname
{
    local($name) = @_;
    $name =~ s/\.(gz|Z)$//;
    $name =~ s/\.(tar|tgz|taz)$//;
    $name =~ s@^.*/([^/]+)$@$1@;
    local($base, $n) = ($name, 0);
    while((-e $name) && $n++ < 50)
    {
	$name = "$base.$n";
    }
    
    die "Can't find unused name for directory!\n" if -e $name;
    $name;
}

sub make_dir
{
    local($dirname) = &make_dirname($tarfile);
    mkdir($dirname, 0777);
    $tarfile = "../$tarfile" unless $tarfile =~ m@^[/~]@;
    chdir($dirname);
    $dirname;
}

sub explode_tar
{
#    local($tarfile) = @_;
    local($tarcmd) = (&tar_cmd($tarfile, "x$verbose"));
    `$tarcmd`;
}

@files = @ARGV;
foreach $tarfile (@files)
{
    if(!(-f $tarfile)) {
	print STDERR "$tarfile not found.\n";
	next;
    }
    next if !&test_tar($tarfile);

    local($retval) = (&evaluate($tarfile));

    if ($retval == 1)
    {
        $dir = &make_dir();
        print "Placing files in new directory: $dir\n";
	&explode_tar($tarfile);
    } elsif ( $retval == 2 )
    {
        print "Absolute paths detected.  Quitting.\n";
    } else {
	&explode_tar($tarfile);
    }
}