写一个perl解压缩的程序能彻底解压一个.tar.gz文件【附上程序代码】

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

1^# systemalgorithm 发表于 2007-09-29 16:10

写一个perl解压缩的程序能彻底解压一个.tar.gz文件【附上程序代码】

程序要求是：
unzip.pl input.tar.gz

input.tar.gz 文件里还有a.tar.gz;b.tar.gz文件; a.tar.gz文件里还有.tar, .jar文件。

这个程序的目的就是要把input.tar.gz文件里的所有可以解压的tar/jar/tar.gz文件都给解了。

jigloo

UID: 21372
帖子: 1
积分: 2
在线时间: 10 分钟

2^# jigloo 发表于 2007-09-29 16:12

win的下挂个gzip.exe，然后就File::Find找*.tar.gz或*.tgz

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

3^# systemalgorithm 发表于 2007-09-29 16:18

呵呵，关键是解压一个就得查看解压的目录里是否还有新的没解的.tar, .jar or .tar.gz.如果有，继续解。直到所有的都搞定。

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

4^# systemalgorithm 发表于 2007-09-29 16:19

程序刚刚写完。花了3个多小时。还不能覆盖解压

Lonki

UID: 21498
帖子: 1
积分: 2
在线时间: 10 分钟

5^# Lonki 发表于 2007-09-29 17:48

QUOTE:

原帖由 systemalgorithm 于 2007-9-29 16:10 发表
程序要求是：
unzip.pl input.tar.gz

input.tar.gz 文件里还有a.tar.gz;b.tar.gz文件; a.tar.gz文件里还有.tar, .jar文件。

这个程序的目的就是要把input.tar.gz文件里的所有可以解压的tar/jar/tar. ...

典型的递归.

写了个, 测试下来暂时OK

use strict;
use warnings;

############# Main Begin ################

if ($ARGV[0]) {
&deep_unzip($ARGV[0]);
}
else {
print "Usage: DeepUnzip.pl 'file1' 'file2' 'filen'\n";
}

############# Main End ##################

### unzip the target recursively
sub deep_unzip {
my $target = shift;

if ($target =~ /\.jar$/i) {
      print "jar -xf $target\n";
      system("jar -xf $target");
      $target =~ s/\.jar$//i;
}
elsif ($target =~ /\.tar$/i) {
      print "tar -xf $target\n";
      system("tar -xf $target");
      $target =~ s/\.tar$//i;
}
elsif ($target =~ /\.tar\.gz$/i) {
      print "gunzip -f $target\n";
      system("gunzip -f $target");
      $target =~ s/\.gz$//i;

      print "tar -xf $target\n";
      system("tar -xf $target");
      $target =~ s/\.tar$//i;
}

# unzip the new files recursively
if (-d $target) {
      print "cd $target\n";
      chdir($target);
      my @new_files = glob "*";
      foreach (@new_files) {
         &deep_unzip($_);
      }
      print "cd ..\n";
      chdir('..');
}
}

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

6^# systemalgorithm 发表于 2007-09-30 08:36

递归函数里的局部变量在再次调用本身时是否仍然有效？

Godbach

UID: 39002
帖子: 1
积分: 2
在线时间: 10 分钟

7^# Godbach 发表于 2007-09-30 08:45

LZ可否把程序贴出来让偶学习学习

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

8^# systemalgorithm 发表于 2007-09-30 09:25

#by jim_zhang @ 2007

my $file = $ARGV[0];
die "[Fatal Error:]Input file should be the absolute path/your file\n" if($file !~ /^\//);
my $refiles; ### this is the global ref for array to store .tar,.jar,.tar.gz files.
if( ! is_ar($file) && ! is_tar_gz($file) ){
      die "the file is not a tar/jar/tar.gz file\n";
}else{
      unzipfile($file);
}

#whether the file is jar file

sub is_ar
{
      my $name = shift;
      if($name =~ /\.[j,t]ar$/){
            return 1;
      }else{
            return 0;
      }
}

sub is_tar_gz
{
      my $name = shift;
      if($name =~ /\.tar\.gz$/){
            return 1;
      }else{
            return 0;
      }
}

sub get_dir
{
      my $name = shift;
      $name=~/(.*\/)(.*)$/;
      return ($1,$2);
}

sub unzipfile
{
      my $name = shift;
      my ($cd_dir,$zipfile) = get_dir($name);
      my $current_dir = `pwd`;
      if (is_ar($name) or is_tar_gz($name) )
      {
            $name =~ /(.*?)\.[t,j]ar[\.gz]?/;my $after = $1;
            if ($name =~ /\.tar$/){
                     print "Running  cd $cd_dir;tar xf $name; cd $current_dir \n";
                     chdir($cd_dir);
                     system ("tar xf $name");
                     chdir($current_dir);
            }
            if ($name =~ /\.jar$/){
                     print "Running  cd $cd_dir;unzip xf $name; cd $current_dir \n";
                     chdir($cd_dir);
                     system ("unzip $name -d $after");
                     chdir($current_dir);
            }
            if (is_tar_gz($name)) {
                     print "Running cd $cd_dir; gunzip -c $zipfile | tar xf -; cd $current_dir\n";
                     chdir($cd_dir); system ("gunzip -c $zipfile | tar xf -"); chdir($current_dir);
            }

            my $all_files = read_dir($after);

            for (@$all_files)
            {
                  print "current : @$all_files\n.";
                  shift @$all_files;
                  unzipfile ($_);
            }
}
else
{
      print "This is not an tar/jar/gz file\n";
      return;
}
}

#get all files(.tar,.jar,.tar.gz) in one directory

sub read_dir
{
      my $path=shift;
      my @files;
      opendir(THISDIR,$path);
      @files=readdir THISDIR;
      closedir THISDIR;
      for(@files)
      {
            next if(/^\./);
      #next if(! is_ar($_) );

      #next if(! is_tar_gz($_) );

            if(-d $path.'/'.$_)
            {
                     read_dir($path.'/'.$_);
            }else
            {
                     push @$refiles, $path.'/'.$_ if(is_ar($_) or is_tar_gz($_));
            }
      }
      return $refiles;
}

systemalgorithm

UID: 5243
帖子: 65
积分: 149
在线时间: 6 小时

9^# systemalgorithm 发表于 2007-09-30 09:32

程序里有两个递归函数: unzipfile() 和 read_dir().
unzipfile()里的my $all_files; 我把@$all_files打印出来后发现，它能保留递归前的数组的值。

而read_dir里的$refiles 不能在read_dir里面定义。否则不能返回所有的文件。

不知道为什么？哪位高手能帮忙分析一下？

bood

UID: 9376
帖子: 88
积分: 202
在线时间: 10 小时

10^# bood 发表于 2007-09-30 10:23

用my的话每次递归使用的$all_files都是不同的变量吧
另外unzipfile中定义的$refiles应该不能被read_dir里访问到