Perl - несжатие zip-файлов в окнах слишком медленно

Question

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

Мой текущий UseCase является извлечь ~ 550mb почтовый файл из доли SMB на окна с большим количеством файлов в нем (кварты 5,5 исходный код)

На Linux, это TGZ файл на долю Nfs и для ее функции требуется 67 секунд. (другой метод сжатия, нежели для zip-файлов)

В Windows требуется> 15 минут.

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

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

Plz быть честным, если мои распаковывать функция дерьмо, я не являюсь экспертом 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); 

Если вы специально хотите, чтобы проверить, является ли архивный файл или почтовый индекс, то вы можете использовать ниже:

$ae->is_tar 
$ae->is_zip 

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