use warnings;
use IO::Handle;
-use Cwd qw(chdir fastgetcwd);
+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 !|cpio -id --quiet', #-v #FIXME: --sparse doesn't work, why?
- "zip"=>'unzip -Lq !',
- "a" =>'ar x !',
- "deb"=>'ar x !;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 !',
+ "rpm" =>'rpm2cpio $pathname|cpio -id --quiet', #-v #FIXME: --sparse doesn't work, why?
+ "zip" =>'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",
};
die "Syntax: $0 <pathname((".join("|",map(".$_",sort keys %{+FORMATS})).")|=<ext>)>..."
if !@ARGV;
-my $origdir=fastgetcwd;
+my @extdirs;
+my $origdir=cwd;
for my $fname (@ARGV) {
- $fname=~m#([^/]+)([.=])(\L[^./]+\E)$# or die "Extension not found for archive: $fname";
- my($path,$base,$ext)=($`,$1,$3);
- my($pathname)=($2 eq "=" ? "$path$base" : $fname);
- my $cmd=FORMATS->{$ext} or die "Extension \"$ext\" not known for archive: $fname";
+ 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);
- -d $extdir or mkdir $extdir or die "Unable to create directory \"$extdir\": $!";
+ # 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#^/#;
- $pathname=~s/'/'\\''/g;
- $pathname="'$pathname'";
- $cmd=~s/!/$pathname/g;
+ $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;