Perl - Распаковка zip-файлов в Windows происходит слишком медленно

Question

Я создал функцию распаковки, соединив несколько фрагментов кода и несколько изменений со своей стороны, автоматически обрабатывая тип файла.

Мой текущий сценарий использования - извлечь файл ZIP размером ~550 МБ из общего ресурса SMB в Windows с большим количеством файлов в нем (исходный код qt 5.5)

В Linux это файл tgz в общей папке nfs, и функция извлекает его за 67 секунд. (другой метод распаковки, чем для zip-файлов)

В Windows это занимает>15 минут.

Я думаю об использовании системного (7z $source) вызова в качестве альтернативы.

Есть ли у вас какие-либо предложения, какой самый быстрый способ извлечь ZIP-файл в Windows?

Пожалуйста, честно, если моя функция распаковки - дерьмо, я не эксперт по 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, он предоставляет общий механизм извлечения архива, поэтому вам не нужно устанавливать отдельные модули для tar а также zip,

use Archive::Extract;
my $ae = Archive::Extract->new( archive => $fileToExtract );
my $ok = $ae->extract( to => $targetPath ); 

Если вы хотите проверить, является ли файл tar или zip, вы можете использовать ниже:

$ae->is_tar
$ae->is_zip

Обратите внимание, что Archive::Extract является основным модулем, поэтому вам не нужно устанавливать его отдельно.