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 programmy $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/; $cmd =~ s/arg2/@files/; print `$cmd`;}