http://pwwang.com/2009/01/01/linux下通用解压缩程序perl版/

?

无意中看到有人贴linux中常用的解压缩命令的用法，通常最后都有一个程序叫做sEx， 叫super extractor， 我去SF上下下来看了一下，也是perl写的， 不过真的只是一个通用的解压的程序， 压缩并没有实现， 于是自己动手把通用的解压缩都实现了，供自己用，也供大家方便。

不过说实话， 我用的压缩格式并不多， 并不需要用太多的命令，一般用tar（只归档，不压缩），tar.gz，rar（windows用得多）。

这个程序支持格式：tar，tar.gz，gz，tar.bz2，bz2，tar.bz，bz，tar.Z，Z，zip，rar，lha，rpm

可以压缩，解压，查看压缩包的内容

基本用法：

压缩：exInOne a 归档文件 文件1 <文件2 文件3 …>

解压：exInOne x 归档文件

查看：exInone l 归档文件

#!/usr/bin/perl -w
 
######################################
# Several Extractors in One : exInOne
# Author: pwwang
# Site: http://pwwang.com
# You can distribute it, modify it,
# but keep this information
######################################
 
use warnings;
use strict;
 
my %cmds = ( # 0->program 1->command for decompress 2->command for compress 3->list
    'tar.gz' => ['tar', 'tar -zxvf arg1', 'tar -zcvf arg1 arg2', 'tar -ztvf arg1'],
    'tar' => ['tar', 'tar -xvf arg1', 'tar -cvf arg1 arg2', 'tar -tvf arg1'],
    'tgz' => ['tar', 'tar -zxvf arg1', 'tar -zcvf arg1 arg2', 'tar -ztvf arg1'],
    'gz' => ['gzip', 'gzip -d arg1', 'gzip -cr arg2 > arg1', 'gzip -l arg1'],
    'tar.bz2' => ['tar', 'tar -jxvf arg1', 'tar -jcvf arg1 arg2', 'tar -jtvf arg1'],
    'bz2' => ['bzip2,gtar', 'bzip2 -d arg1', 'bzip2 -cz arg2 > arg1', 'tar -jtvf arg1'],
    'tar.bz' => ['tar', 'tar -jxvf arg1', 'tar -jcvf arg1 arg2', 'tar -jtvf arg1'],
    'bz' => ['bzip2,tar', 'bzip2 -d arg1', 'bzip2 -z arg1', 'tar -jtvf arg1'],
    'tar.Z' => ['tar', 'tar -Zxvf arg1', 'tar -Zcvf arg1 arg2', 'tar -Ztvf arg1'],
    'Z' => ['compress', 'compress -d arg1', 'compress -c arg2 > arg1 ', 'tar -Ztvf arg1'],
    'zip' => ['zip,unzip', 'unzip arg1', 'zip arg1 arg2', 'unzip -Zl arg1'],
    'rar' => ['rar', 'rar x arg1', 'rar a arg1 arg2', 'echo Unsupport listing rar content'],
    'lha' => ['lha', 'lha -e arg1', 'lha -a arg1 arg2', 'lha -l arg1'],
    'rpm' => ['rpm2cpio', 'rpm2cpio arg1 | cpio -div', 'echo Unsupport creating rpm archive', 'rpm2cpio arg1 | cpio -tiv'],
);
 
sub get_ext ($) { #get extension of a file name
    my ($f) = @_;
    my $ext;
    if($f =~ /.+\.(.+)$/){ $ext = $1; } 
    else { $ext = ""; }
    if($ext eq 'gz' || $ext eq 'bz2' || $ext eq 'bz' || $ext eq 'Z'){
        if($f =~ /.+\.(tar\.$ext)/){ $ext = $1;    }
    }
    return $ext;
}
 
sub check4exes { # Check for missing tools
    while (@_>0) {
        my $bin = shift;
        unless( join('|',`which $bin`) =~/\/$bin(\||$)/ ) {
            print "exInOne needs $bin in your \$PATH to handle this format!\n";
            exit 10;
        }
    }
}
 
sub ifTypeSupport ($) {
    my ($ex) = @_;
    if(!exists $cmds{$ex}){
        print "Unsupport file type: $ex \n";
        exit 5;
    }
}
 
sub checkFile ($) { #check file and return available extension
    my ($fn) = @_;
    my ($ex) = get_ext($fn);
    print "File: $fn\n";
    ifTypeSupport($ex);
    my @b = split /,/,$cmds{$ex}->[0];
    check4exes(@b);
    return $ex;
}
 
# Main program
my $command = shift @ARGV; $command="" unless( defined $command );
my $opts="";
if( $command =~ /^-/ ) {
    ($opts) = $command =~ /^-(.*)/;
    $command = shift @ARGV;
}
my $archive = shift @ARGV;
my @files = @ARGV;
 
unless ($command =~ /^(l|x|a)$/) {
    print "Usage: exInOne [-options] command archive [files...]\n";
    print "commands:\n";
    print "    l   List\n";
    print "    x   Extract\n";
    print "    a   Add files or create new archive\n";
    exit 5;
}
 
my $ext = checkFile($archive);
my $cmd;
 
if    ($command eq 'l') {
    $cmd = $cmds{$ext}->[3];
    $cmd =~ s/arg1/$archive/;
    print `$cmd`;
}
elsif ($command eq 'x') {
    $cmd = $cmds{$ext}->[1];
    $cmd =~ s/arg1/$archive/;
    print `$cmd`;
}
elsif ($command eq 'a') {
    $cmd = $cmds{$ext}->[2];
    $cmd =~ s/arg1/$archive/;