Архивировать файлы tar в другое место на Perl

Question

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

Все выглядит хорошо, однако файлы распаковываются в папке с основным модулем Perl-кода, на котором запущены субмодули.

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

Это мой код:

sub ExtractFile
{

 #Read the folder which was copied in the output path recursively and extract if any file is compressed
 my $dirpath = $_[0];

 opendir(D, "$dirpath") || die "Can't open dir $dirpath: $!\n";
 my @list = readdir(D);
 closedir(D);


 foreach my $f (@list) 
 {
  print " \$f = $f";
  if(-f $dirpath."/$f")
  {
   #print " File in  directory $dirpath \n ";#is \$f = $f\n";

   my($file_name, $file_dirname,$filetype)= fileparse($f,qr{\..*});

   #print " \nThe file extension is $filetype";
   #print " \nThe file name is is $file_name";


   # If compressed file then extract the file
   if($filetype eq ".tar" or $filetype eq ".tzr.gz")
   {

    my $arch_file = $dirpath."/$f";
    print "\n file to be extracted is $arch_file";
    my $tar = Archive::Tar->new($arch_file);
    #$tar->extract() or die ("Cannot extract file $arch_file");

    #mkdir($dirpath."/$file_name");
    $tar->extract_file($arch_file,$dirpath."/$file_name" ) or die ("Cannot extract file $arch_file");
   }

  }
  if(-d $dirpath."/$f")
  {
   if($f eq "." or $f eq "..")
   { next; }
   print " Directory\n";# is $f";
   ExtractFile($dirpath."/$f");
  }

 }


}

Метод ExtractFile вызывается рекурсивно для зацикливания всех архивов. При использовании $tar->extract() он распаковывается в папку, которая вызывает этот метод.

Когда я использую $tar->extract_file($arch_file,$dirpath."/$file_name"), я получаю сообщение об ошибке:

Нет такого файла в архиве: '/home/fsang/dante/workspace/output/s.tar' в /home/fsang/dante/lib/Extraction.pm строка 80

Пожалуйста, помогите. Я проверил, что путь и входной вывод не имеют проблем с ним.

Кажется, что некоторые проблемы с использованием, о которых я не знаю, $tar->extract_file().

Большое спасибо за решение этой проблемы.

С уважением, Sakshi

Answer 1

Вы неправильно поняли extract_file. Первый параметр - это имя файла внутри архива для извлечения. Вы проходите по пути самого архива. Вы передали это new; Вам не нужно передавать это снова. Как объясняется в сообщении об ошибке, s.tar не содержит файл с именем /home/fsang/dante/workspace/output/s.tar, поэтому extract_file завершается ошибкой.

Вы можете получить список файлов в архиве, используя $tar->list_files.

Более простым решением может быть временное обращение к каталогу, в который вы хотите извлечь архив, временным путем. File :: pushd предоставляет простой способ сделать это.

Answer 2

Я вижу пистолет, который приносят на бой в швейцарской армии. Вот * nix one-liner, который делает то, что вы хотите:

find /source/dir -name "*.tar" -exec tar -C /target/dir -xvzf '{}' \; -print

Есть ли необходимость написать скрипт для этого? Вы не обязательно делаете что-то особенное, кроме строк отладки.

Answer 3

$tarFile = "test.tar.gz";
$myTar = Archive::Tar->new($tarFile);
foreach my $member ($myTar->list_files())
{
    my $res = $myTar->extract_file( $member , 'C:/temp/'.$member );
    print "Exract error!\n" unless ($res);
}

Answer 4

опечатка?

$tar->extract_file($arch_file,$dirpath."/$file_name" ) 

должно быть

$tar->extract_file($arch_file,$dirpath."/".$file_name)