CODEWITHSUNDEEP
regexperlzipcompression
MicrobicTiger
MicrobicTiger

Reputation: 597

perl Zipping a folder without the working directory file path

I am trying to compress a folder containing files and subfolders (with files) into a single zip. I'm limited to the core perl modules so I'm trying to work with IO::Compress::Zip. I want to remove the working directory file path but seem to end up with a blank first folder before my zipped folder, like there is a trailing "/" I haven't been able to get rid of. 

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";

I have also attempted using the option "CanonicalName => 1, " which appears to leave the filepath except the drive letter (C:). Substitution with 

s[^$dir/][]

did nothing and 

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

left me with no folder structure at all.

What am I missing?

UPDATE Resultant Zip contents (blurred to protect the innocent) in 7Zip

The Red level is unexpected and is what is not required, win explorer is not able to see beyond this level.

Upvotes: 0

Views: 1158

Answers (2)

pmqs
pmqs

Reputation: 3735

There are two issues with your script.

First, you are mixing Windows and Linux/Unix paths in the script. Let me illustrate

I've created a subdirectory called source_folder to match your script

 $ 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

When I run your script unmodified I get an apparently empty zip file when I view it in Windows explorer. But, if I use a command-line unzip, I see that source_folder.zip isn't empty, but it has non-standard filenames that are part Windows and part 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

The mix-and-match of windows & Unix paths is created in this line of your script

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

You are concatenating a Unix-style path in $cwd with a windows part "\source_folder".

Change the line to use a forward slash, rather than a backslash to get a consistent Unix-style path.

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

The second problem is this line

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

The substitute, s|\Q$cwd||, needs an extra "/", like this s|\Q$cwd/|| to make sure that the path added to the zip archive is a relative path. So the line becomes

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

Once those two changes are made I can view the zip file in Explorer and get unix-style relative paths in when I use the command-line 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

Upvotes: 1

clamp
clamp

Reputation: 3347

This works for me:

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";

I changed the path seperator to '/' in your call to find() and also stripped it in the FilterName sub. console:

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

Upvotes: 0

Related Questions