#! /usr/bin/perl
#
#	$Id$

use strict;
use warnings;

use IO::Handle;
use Cwd qw(chdir cwd);

use constant FORMAT_TAR=>'tar xf $pathname;i=`echo *`;echo "$i"|grep -q " " || test * != $base ||'
                         .'(mv "$i" "$i".$$;(set +x;mv "$i".$$/* .);rmdir "$i".$$)';
use constant FORMATS=>{
	"rpm"    =>'rpm2cpio $pathname|cpio -id --quiet',	#-v #FIXME: --sparse doesn't work, why?
	"zip"    =>'unzip -Lq $pathname',
	"jar"    =>'unzip -Lq $pathname',
	"a"      =>'ar x $pathname',
	"deb"    =>'ar x $pathname;'
	           .'for i in *.tar.gz;do j=`basename $i .tar.gz`;mkdir -p $j;cd $j;tar xzf ../$i;cd ..;rm -f $i;done',
	"arj"    =>'unarj x $pathname',
	"tar"    =>FORMAT_TAR,
	"tar.gz" =>do { $_=FORMAT_TAR; s/xf/xzf/; $_; },
	"tgz"    =>"tar.gz",
	"tar.bz2"=>do { $_=FORMAT_TAR; s/xf/xjf/; $_; },
	"tar.bz" =>"tar.bz2",
	"tbz"    =>"tar.bz",
	"msi"    =>'cabextract -q $pathname',
	};

die "Syntax: $0 <pathname((".join("|",map(".$_",sort keys %{+FORMATS})).")|=<ext>)>..."
		if !@ARGV;

my @extdirs;
my $origdir=cwd;
for my $fname (@ARGV) {
	my @parsed;
	for my $fmt (sort { length $b<=>length $a; } keys %{+FORMATS}) {
		last if @parsed=$fname=~m#^(.*?)([^/]+)([.=])(\Q$fmt\E)$#i;
		}
	$parsed[3] or die "Extension not found for archive: $fname";
	my($path,$base,$ext)=@parsed[0,1,3];
	my($pathname)=($parsed[2] eq "=" ? "$path$base" : $fname);
	my($cmdtry,$cmd)=(lc $ext);
	do {
		$cmd=$cmdtry;
		$cmdtry=FORMATS->{$cmdtry};
		} while ($cmdtry);
	-r $pathname && !-d $pathname or die "Archive not readable: $pathname";
	my($extdir)=(-e $base && !-d $base ? "$base.dir" : $base);
	# Extraction-overwriting cowardly not supported:
			# -d $extdir or ...
	mkdir $extdir or die "Unable to create directory \"$extdir\": $!";
	chdir $extdir or die "Unable to chdir to \"$extdir\": $!";
	$pathname="../$pathname" if $pathname!~m#^/#;
	$path    ="../$path"     if $path    !~m#^/#;
	$cmd="set -ex;$cmd";
	my %substvars=(
			"pathname"=>\$pathname,
			"path"    =>\$path,
			"base"    =>\$base,
			"ext"     =>\$ext,
			"extdir"  =>\$extdir,
			);
	while (my($name,$var)=each %substvars) {
		($_=$$var)=~s/'/'\\''/g;
		$cmd="$name='$_';$cmd";
		}
	print "\t$extdir/:\n"; STDOUT->flush();
	my $rc;
	$rc=system $cmd and die "$cmd (rc=".($rc>>8)."): $!";
	push @extdirs,$extdir;
	}
	continue {
		chdir $origdir;
		}
print "extdir=".$extdirs[0]."\n" if 1==@extdirs;
exit 0;