linux下通用解压缩程序Perl版
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/;
