Perl Zip папка без пути к файлу рабочего каталога

Question

Я пытаюсь сжать папку, содержащую файлы и подпапки (с файлами), в один zip.Я ограничен основными модулями Perl, поэтому я пытаюсь работать с IO :: Compress :: Zip.Я хочу удалить путь к рабочему файлу каталога, но, похоже, в итоге у меня появляется пустая первая папка перед моей заархивированной папкой, как в конце "/", от которого я не смог избавиться.

use Cwd;
use warnings;
use strict;
use File::Find;
use IO::Compress::Zip qw(:all);

my $cwd = getcwd();
   $cwd =~ s/[\\]/\//g;

print $cwd, "\n";
my $zipdir  = $cwd . "\\source_folder";
my $zip = "source_folder.zip";

my @files = ();

sub process_file {
    next if (($_ eq '.') || ($_ eq '..'));
    if (-d && $_ eq 'fp'){
        $File::Find::prune = 1;
        return;
    }
    push @files, $File::Find::name if -f;
}
find(\&process_file, $cwd . "\\source_folder");

zip \@files  => "$zip", FilterName => sub{ s|\Q$cwd|| }  or die "zip failed: $ZipError\n";

Я также пытался использовать опцию «CanonicalName => 1», которая, похоже, оставляет путь к файлу, кроме буквы диска (C :).Подстановка

s[^$dir/][]

ничего не сделала и

s<.*[/\\]><>

не оставила мне вообще никакой структуры папок.

Чего мне не хватает?

ОБНОВЛЕНИЕ

Уровень красного является неожиданным и является тем, что не требуется, проводник win не может видеть дальше этого уровня.

Answer 1

У вашего скрипта есть две проблемы.

Во-первых, вы смешиваете пути Windows и Linux / Unix в скрипте.Позвольте мне проиллюстрировать

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

 $ dir source_folder
 Volume in drive C has no label.
 Volume Serial Number is 7CF0-B66E

 Directory of C:\Scratch\source_folder

26/11/2018  19:48    <DIR>          .
26/11/2018  19:48    <DIR>          ..
26/11/2018  17:27               840 try.pl
01/06/2018  13:02             6,653 url
               2 File(s)          7,493 bytes

Когда я запускаю ваш скрипт без изменений, я получаю очевидно пустой zip-файл при просмотре в проводнике Windows.Но, если я использую распаковку командной строки, я вижу, что source_folder.zip не пуст, но у него есть нестандартные имена файлов, которые являются частью Windows и частью Linux / Unix.

$ unzip -l source_folder.zip
Archive:  source_folder.zip
  Length      Date    Time    Name
---------  ---------- -----   ----
      840  2018-11-26 17:27   \source_folder/try.pl
     6651  2018-06-01 13:02   \source_folder/url
---------                     -------
     7491                     2 files

Смесь-и-совпадение путей Windows и Unix создается в этой строке вашего скрипта

find(\&process_file, $cwd . "\\source_folder");

Вы объединяете путь в стиле Unix в $ cwd с частью windows "\ source_folder".

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

find(\&process_file, $cwd . "/source_folder");

Вторая проблема - эта строка

zip \@files  => "$zip", 
        FilterName => sub{ s|\Q$cwd|| },
        BinmodeIn =>1
   or die "zip failed: $ZipError\n";

Для замены, s|\Q$cwd||, требуется дополнительный символ "/", например s|\Q$cwd/||, чтобы убедиться, что путь, добавленный в zip-архив, является относительным путем.Таким образом, строка становится

zip \@files  => "$zip", FilterName => sub{ s|\Q$cwd/|| }  or die "zip failed: $ZipError\n";

После внесения этих двух изменений я могу просмотреть zip-файл в проводнике и получить относительные пути в стиле Unix при использовании командной строки unzip

$ unzip -l source_folder.zip
Archive:  source_folder.zip
  Length      Date    Time    Name
---------  ---------- -----   ----
      840  2018-11-26 17:27   source_folder/try.pl
     6651  2018-06-01 13:02   source_folder/url
---------                     -------
     7491                     2 files

Answer 2

Это работает для меня:

use Cwd;
use warnings;
use strict;
use File::Find;
use IO::Compress::Zip qw(:all);
use Data::Dumper;

my $cwd = getcwd();
$cwd =~ s/[\\]/\//g;

print $cwd, "\n";
my $zipdir  = $cwd . "/source_folder";
my $zip = "source_folder.zip";

my @files = ();

sub process_file {
    next if (($_ eq '.') || ($_ eq '..'));
    if (-d && $_ eq 'fp') {
        $File::Find::prune = 1;
        return;
    }
    push @files, $File::Find::name if -f;
}
find(\&process_file, $cwd . "/source_folder");
print Dumper \@files;
zip \@files  => "$zip", FilterName => sub{ s|\Q$cwd/|| }  or die "zip failed: $ZipError\n";

Я изменил разделитель пути на '/' в вашем вызове find (), а также удалил его в подпрограмме FilterName.консоль:

C:\Users\chris\Desktop\devel\experimente>mkdir source_folder
C:\Users\chris\Desktop\devel\experimente>echo 1 > source_folder/test1.txt
C:\Users\chris\Desktop\devel\experimente>echo 1 > source_folder/test2.txt
C:\Users\chris\Desktop\devel\experimente>perl perlzip.pl
C:/Users/chris/Desktop/devel/experimente
Exiting subroutine via next at perlzip.pl line 19.
$VAR1 = [
      'C:/Users/chris/Desktop/devel/experimente/source_folder/test1.txt',
      'C:/Users/chris/Desktop/devel/experimente/source_folder/test2.txt'
    ];

C:\Users\chris\Desktop\devel\experimente>tar -tf source_folder.zip
source_folder/test1.txt
source_folder/test2.txt