#! /usr/bin/perl # # $Id$ use strict; use warnings; use IO::Handle; use Cwd qw(chdir cwd); use constant FORMAT_TAR_GZ=>'tar xzf $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', "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.gz" =>FORMAT_TAR_GZ, "tgz" =>"tar.gz", "tar.bz2"=>do { $_=FORMAT_TAR_GZ; s/xzf/xjf/; $_; }, "tar.bz" =>"tar.bz2", "tbz" =>"tar.bz", }; die "Syntax: $0 )>..." if !@ARGV; my $origdir=cwd; for my $fname (@ARGV) { my @parsed; for my $fmt (sort { length $b<=>length $a; } keys %{+FORMATS}) { (my $fmtt=$fmt)=~s/(\W)/\\$1/g; last if @parsed=$fname=~m#^(.*?)([^/]+)([.=])($fmtt)$#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)=($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)."): $!"; } continue { chdir $origdir; } exit 0;