e8c941adac74b323e4faaa727d1529e0e72e30f6
[nethome.git] / 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=>'tar xf $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         "jar"    =>'unzip -Lq $pathname',
17         "xpi"    =>'unzip -Lq $pathname',
18         "a"      =>'ar x $pathname',
19         "deb"    =>'ar x $pathname;'
20                    .'for i in *.tar.gz;do j=`basename $i .tar.gz`;mkdir -p $j;cd $j;tar xzf ../$i;cd ..;rm -f $i;done',
21         "arj"    =>'unarj x $pathname',
22         "tar"    =>FORMAT_TAR,
23         "tar.gz" =>do { $_=FORMAT_TAR; s/xf/xzf/; $_; },
24         "tgz"    =>"tar.gz",
25         "tar.bz2"=>do { $_=FORMAT_TAR; s/xf/xjf/; $_; },
26         "tar.bz" =>"tar.bz2",
27         "tbz"    =>"tar.bz",
28         "tar.xz" =>do { $_=FORMAT_TAR; s/xf/xJf/; $_; },
29         "txz"    =>do { $_=FORMAT_TAR; s/xf/xJf/; $_; },
30         "msi"    =>'cabextract -q $pathname',
31         };
32
33 die "Syntax: $0 <pathname((".join("|",map(".$_",sort keys %{+FORMATS})).")|=<ext>)>..."
34                 if !@ARGV;
35
36 my @extdirs;
37 my $origdir=cwd;
38 for my $fname (@ARGV) {
39         my @parsed;
40         for my $fmt (sort { length $b<=>length $a; } keys %{+FORMATS}) {
41                 last if @parsed=$fname=~m#^(.*?)([^/]+)([.=])(\Q$fmt\E)$#i;
42                 }
43         $parsed[3] or die "Extension not found for archive: $fname";
44         my($path,$base,$ext)=@parsed[0,1,3];
45         my($pathname)=($parsed[2] eq "=" ? "$path$base" : $fname);
46         my($cmdtry,$cmd)=(lc $ext);
47         do {
48                 $cmd=$cmdtry;
49                 $cmdtry=FORMATS->{$cmdtry};
50                 } while ($cmdtry);
51         -r $pathname && !-d $pathname or die "Archive not readable: $pathname";
52         my($extdir)=(-e $base && !-d $base ? "$base.dir" : $base);
53         # Extraction-overwriting cowardly not supported:
54                         # -d $extdir or ...
55         mkdir $extdir or die "Unable to create directory \"$extdir\": $!";
56         chdir $extdir or die "Unable to chdir to \"$extdir\": $!";
57         $pathname="../$pathname" if $pathname!~m#^/#;
58         $path    ="../$path"     if $path    !~m#^/#;
59         $cmd="set -ex;$cmd";
60         my %substvars=(
61                         "pathname"=>\$pathname,
62                         "path"    =>\$path,
63                         "base"    =>\$base,
64                         "ext"     =>\$ext,
65                         "extdir"  =>\$extdir,
66                         );
67         while (my($name,$var)=each %substvars) {
68                 ($_=$$var)=~s/'/'\\''/g;
69                 $cmd="$name='$_';$cmd";
70                 }
71         print "\t$extdir/:\n"; STDOUT->flush();
72         my $rc;
73         $rc=system $cmd and die "$cmd (rc=".($rc>>8)."): $!";
74         push @extdirs,$extdir;
75         }
76         continue {
77                 chdir $origdir;
78                 }
79 print "extdir=".$extdirs[0]."\n" if 1==@extdirs;
80 exit 0;