bin/exx

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use IO::Handle;
   9 use Cwd qw(chdir cwd);
  10
  11 use constant FORMAT_TAR_GZ=>'tar xzf $pathname;i=`echo *`;echo "$i"|grep -q " " || test * != $base ||'
  12                             .'(mv "$i" "$i".$$;(set +x;mv "$i".$$/* .);rmdir "$i".$$)';
  13 use constant FORMATS=>{
  14         "rpm"    =>'rpm2cpio $pathname|cpio -id --quiet',       #-v #FIXME: --sparse doesn't work, why?
  15         "zip"    =>'unzip -Lq $pathname',
  16         "a"      =>'ar x $pathname',
  17         "deb"    =>'ar x $pathname;'
  18                    .'for i in *.tar.gz;do j=`basename $i .tar.gz`;mkdir -p $j;cd $j;tar xzf ../$i;cd ..;rm -f $i;done',
  19         "arj"    =>'unarj x $pathname',
  20         "tar.gz" =>FORMAT_TAR_GZ,
  21         "tgz"    =>"tar.gz",
  22         "tar.bz2"=>do { $_=FORMAT_TAR_GZ; s/xzf/xjf/; $_; },
  23         "tar.bz" =>"tar.bz2",
  24         "tbz"    =>"tar.bz",
  25         };
  26
  27 die "Syntax: $0 <pathname((".join("|",map(".$_",sort keys %{+FORMATS})).")|=<ext>)>..."
  28                 if !@ARGV;
  29
  30 my @extdirs;
  31 my $origdir=cwd;
  32 for my $fname (@ARGV) {
  33         my @parsed;
  34         for my $fmt (sort { length $b<=>length $a; } keys %{+FORMATS}) {
  35                 (my $fmtt=$fmt)=~s/(\W)/\\$1/g;
  36                 last if @parsed=$fname=~m#^(.*?)([^/]+)([.=])($fmtt)$#i;
  37                 }
  38         $parsed[3] or die "Extension not found for archive: $fname";
  39         my($path,$base,$ext)=@parsed[0,1,3];
  40         my($pathname)=($parsed[2] eq "=" ? "$path$base" : $fname);
  41         my($cmdtry,$cmd)=($ext);
  42         do {
  43                 $cmd=$cmdtry;
  44                 $cmdtry=FORMATS->{$cmdtry};
  45                 } while ($cmdtry);
  46         -r $pathname && !-d $pathname or die "Archive not readable: $pathname";
  47         my($extdir)=(-e $base && !-d $base ? "$base.dir" : $base);
  48         # Extraction-overwriting cowardly not supported:
  49                         # -d $extdir or ...
  50         mkdir $extdir or die "Unable to create directory \"$extdir\": $!";
  51         chdir $extdir or die "Unable to chdir to \"$extdir\": $!";
  52         $pathname="../$pathname" if $pathname!~m#^/#;
  53         $path    ="../$path"     if $path    !~m#^/#;
  54         $cmd="set -ex;$cmd";
  55         my %substvars=(
  56                         "pathname"=>\$pathname,
  57                         "path"    =>\$path,
  58                         "base"    =>\$base,
  59                         "ext"     =>\$ext,
  60                         "extdir"  =>\$extdir,
  61                         );
  62         while (my($name,$var)=each %substvars) {
  63                 ($_=$$var)=~s/'/'\\''/g;
  64                 $cmd="$name='$_';$cmd";
  65                 }
  66         print "\t$extdir/:\n"; STDOUT->flush();
  67         my $rc;
  68         $rc=system $cmd and die "$cmd (rc=".($rc>>8)."): $!";
  69         push @extdirs,$extdir;
  70         }
  71         continue {
  72                 chdir $origdir;
  73                 }
  74 print "extdir=".$extdirs[0]."\n" if 1==@extdirs;
  75 exit 0;