Question

我创建了一个解压缩功能，从几个代码片段和我身边的一些改动中组合起来，自动处理文件类型。

我目前的用例是从Windows上的SMB共享中提取~550mb的zip文件，其中包含大量文件（qt 5.5源代码）

在Linux上，这是nfs共享上的tgz文件，该函数需要67秒才能解压缩。（其他解压缩方法比zip文件）

在Windows上，它需要> 15分钟。

我正在考虑使用系统（7z $ source）调用作为替代方案。

您有什么建议在Windows上提取zip文件的最快方法是什么？

说实话，如果我的解压缩功能是垃圾，我不是perl专家...... :)

这是我的代码：

#uncompress full archive file $archFile to $destPath
sub uncompress
{
  my $fileToExtract = shift;
  my $targetPath = shift;
  my $silent = shift;
  my $status;
  my $buff;

  unless (-f $fileToExtract)
  {
    &error ("$fileToExtract is not a file!"); 
  }

  unless (-d $targetPath)
  {
    &makeDir($targetPath, 1);
  }

  # just look for .tar since all .tar archives with all compressions can be extracted.
  if ($fileToExtract =~ m/.tar/)
  {
    my $pwd = getcwd();
    changeDirectory($targetPath, 1);
    my $tar = Archive::Tar->new();

    $tar->read($fileToExtract);
    $tar->extract();
    changeDirectory($pwd, 1);


    return; 
  }

  elsif ($fileToExtract =~ m/.zip$/)
  {
    my $u = new IO::Uncompress::Unzip $fileToExtract or die "Cannot open $fileToExtract: $UnzipError";

    for ($status = 1; $status > 0; $status = $u->nextStream()) 
    {
      my $header = $u->getHeaderInfo();
      my (undef, $path, $name) = splitpath($header->{Name});
      my (undef, $path, $name) = splitpath($header->{Name});
      my $destdir = "$targetPath$path";

      unless (-d $destdir)
      {
        &makeDir( $destdir, 1);
      }

      if ($name =~ m!/$!) {
        last if $status < 0;
        next;
      }


      my $destfile = "$destdir/$name";

      if ($destfile =~ m/\/\/$/) # skip if no filename is given
      {
        next;
      }

      $destfile =~ s|\/\/|\/|g; # remove unnecessary doubleslashes

      my $fh = openFileHandle ( $destfile , '>', 1 );

      binmode($fh);
      while (($status = $u->read($buff)) > 0) {
        $fh->write($buff);
      }
      $fh->close();

      unless (defined $silent)
      {
        &syslog ("Uncompress $destfile -> $targetPath");
      }

      #set timestamps of file to the ones in the zip
      my $stored_time = $header->{'Time'};
      utime ($stored_time, $stored_time, $destfile);
    }

    if ($status < 0)
    {
      die "Error processing $fileToExtract: $!\n"
    } 
  }
  else
  {
    my $ae = Archive::Extract->new( archive => $fileToExtract );
    $ae->extract( to => $targetPath ) or &error("Failed to extract $fileToExtract with error $ae->error");

    unless (defined $silent)
    {
      foreach my $file (@{$ae->files})
      {
        #only print if not a directory
        if( $file!~m|/$| )
        {
          &syslog("Uncompress $fileToExtract -> $targetPath");
        }
      }
    }
  }
  return;
}

Answer 1

您可以使用Archive::Extract以下面的方式执行此操作，它提供了通用归档提取机制，因此您不必为zip和use Archive::Extract; my $ae = Archive::Extract->new( archive => $fileToExtract ); my $ok = $ae->extract( to => $targetPath );安装单独的模块。

$ae->is_tar
$ae->is_zip

如果您特别想检查文件是tar还是zip，那么您可以使用以下内容：

one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety,hundred,thousands,million,billion

请注意，Archive::Extract是核心模块，因此您无需单独安装。

Perl - 在Windows上解压缩zip文件太慢了

1 个答案: