I'm trying to zip up image files using Archive::Zip. The files are in Data/Temp/Files When I loop through the logs in the directory and add them to the zip file, I end up with the folder hierarchy and the image files when I only want the image files.
So the zip ends up containing:
Data
└Temp
└Files
└Image1.jpg
Image2.jpg
Image3.jpg
When I want the zip file to contain is:
Image1.jpg
Image2.jpg
Image3.jpg
Here is the script I'm running to test with:
#!/usr/bin/perl
use Archive::Zip;
$obj = Archive::Zip->new(); # new instance
#files = <Data/Temp/Files/*>;
foreach $file (#files) {
$obj->addFile($file); # add files
}
$obj->writeToFileNamed("Data/Temp/Files/Images.zip");
Use chdir to change into the directory:
use Archive::Zip;
$obj = Archive::Zip->new(); # new instance
chdir 'Data/Temp/Files';
#files = <*>;
foreach $file (#files) {
$obj->addFile($file); # add files
}
$obj->writeToFileNamed("Images.zip");
The names and paths of zip archive members are completely independent of those of their real file counterparts. Although the two names are conventionally the same, AddFile allows you to specify a second parameter which is the name and path of the corresponding archive member where the file information should be stored
You can achieve the effect you're asking for my using basename from the File::Basename module to extract just the file name from the complete path
This program demonstrates. Note that it is essential to use strict and use warnings at the top of every Perl program you write
use strict;
use warnings;
use Archive::Zip;
use File::Basename 'basename';
my $zip = Archive::Zip->new;
for my $jpg ( glob 'Data/Temp/Files/*.jpg' ) {
$zip->addFile($jpg, basename($jpg));
}
$zip->writeToFileNamed('Data/Temp/Files/Images.zip');
Related
I'm writing a Perl scipt that unzips the zip file and moves the content of zip file to a directory, however I want to skip the zip file which do not have any content in it. How can I filter these files. For unzipping the file I'm using
unzip_content = system("unzip -d <directory> -j -a <filepath>")
Could anyone suggest me anyway to check if it does not contain anything.
I tried with checking the filesize using -s $filename but later I got some files with filesize 22 byte but with no content in it.
You can use Archive::Zip to achieve all of that inside of your Perl program without shelling out. You need to check if the archive contains anything, which can be done with the numberOfMembers method.
use strict;
use warnings;
use Archive::Zip qw/:ERROR_CODES/;
my #files = ...;
foreach my $file (#files) {
my $zip = Archive::Zip->new;
# skip if archive cannot be opened
next unless $zip->read($file) == AZ_OK;
# skip if archive is empty
next unless $zip->numberOfMembers;
# extract everything
$zip->extractTree({zipName => '<directory>'});
}
An other way to check the same thing is to calculate the MD5 hash of the file. MD5 hash of all empty zip files would be 76cdb2bad9582d23c1f6f4d868218d6c.
Helpful links:
minimum size zip file
Digest::MD5
use strict;
use warnings;
use Digest::MD5 qw(md5 md5_hex md5_base64);
my $filedir = "/home/docs/file.zip";
open FILE, "$filedir";
my $ctx = Digest::MD5->new;
$ctx->addfile (*FILE);
my $hash = $ctx->hexdigest;
close (FILE);
if($hash eq '76cdb2bad9582d23c1f6f4d868218d6c')
{
# empty file
}
I am trying to access a text file within a zipped folder to extract a certain information, without actually unzipping the file. I am trying to use Archive::Zip. The directory structure is like Data_stats.zip--> Data_stats/ --> full_data_stats.txt. Now I tried this
use Archive::Zip;
use Archive::Zip::MemberRead;
use File::Basename;
$zip_dir=$ARGV[0];
#name =split("\\.",basename($zip_dir)); ## to get zipped folder name
$dir = Archive::Zip->new("$zip_dir");
$fh = Archive::Zip::MemberRead->new($dir,"$name[0]/full_data_stats.txt"); ##trying to reads the file giving the path and mentioning the specific file name
while (defined($line = $fh->getline()))
{
{print}
}
I see it extracting the folder but not reading in the file !!.
Regards
You are assigning to $line but printing $_; try print $line;
Assuming I have the following array of file names I wish to zip
my #files = ("C:\Windows\Perl\test1.txt", "C:\Windows\Perl\test2.txt", "C:\Windows\Perl\test3.txt");
If I do
$obj = Archive::Zip->new();
foreach (#files)
{
$obj->addFile($_);
}
$obj->writeToFileNamed("zippedFolders.zip");
When I open zippedFolders.zip I see it contains subfolders, namely Windows and Perl, the latter which actually contains test1, test2, and test3. For some reason, the folders themselves are getting zipped up.
How can I make it so that only the files get zipped up and not have to click Windows then Perl folders to access the zipped files?
As you have see, if you use addFile to add a disk file to an archive, then Archive::Zip adds an archive member with the same path as file had originally. If you want it stored as something different then you can pass a second parameter that will be used as the name and path of the archive member created.
For your purposes I suggest you use the core File::Basename module to remove the path from the filename and pass just the basename as the second parameter.
The code below demonstrates.
Something else you need to be aware of is that you can't use single backslashes in Perl double quotes - they will be seen as escaping the following character and simply disappear. You can use pairs of backslashes in the string, use single quotes instead, use forward slashes instead (Perl will sort things out) or if there are no spaces in the filenames then you can use qw() as I have in this program.
use strict;
use warnings;
use Archive::Zip;
use File::Basename 'basename';
my #files = qw/
C:\Windows\Perl\test1.txt
C:\Windows\Perl\test2.txt
C:\Windows\Perl\test3.txt
/;
my $zip = Archive::Zip->new;
foreach my $file (#files) {
my $member = basename $file;
printf qq{Adding file "%s" as archive member "%s"\n}, $file, $member;
$zip->addFile($file, $member);
}
$zip->writeToFileNamed('zippedFolders.zip');
output
Adding file "C:\Windows\Perl\test1.txt" as archive member "test1.txt"
Adding file "C:\Windows\Perl\test2.txt" as archive member "test2.txt"
Adding file "C:\Windows\Perl\test3.txt" as archive member "test3.txt"
I have a directory or folder consisting of hundreds of files. They are named and arranged alphabatically. I want to move the files into directories or folders according to the first character of their name (i.e. files starting with a into one folder, files starting with r into another folder, etc).
Is there a way to do it without using CPAN modules?
Are the files all in that one folder, or are they in subfolders? If they are all in a single folder, you can use opendir to access the directory, and then readdir to read the file names and copy them elsewhere (using File::Copy module's move or copy function.
use strict;
use warnings;
use autodie;
use File::Copy; #Gives you access to the "move" command
use constant {
FROM_DIR => "the.directory.you.want.to.read",
TO_DIR => "the.directory.you want.to.move.the.files.to",
};
#Opens FROM_DIR, ao I can read from it
opendir my $dir, FROM_DIR;
# Loopa through the directory
while (my $file = readdir $dir) {
next if ($file eq "." or $file eq "..");
my $from = FROM_DIR . "/" . "$file";
move $from, TO_DIR;
}
This doesn't do exactly what you want, but it should give you the idea. Basically, I'm using opendir and readdir to read the files in the directory and I'm using move to move them to another directory.
I used the File::Copy module, but this is included in all Perl distributions, so it's not a CPAN module that must be installed.
Use glob(), or the built-in File::Find to build a list of files for each starting letter.
I have a folder called "Lib" in my drive it contains many files inside and I have a problem that this "Lib" folder is there in many other places in the drive. My Perl script has to copy the contents from folder "Lib" which are latest updated and paste it in the folder "d:\perl\Latest_copy_of_Lib"
For example, I have a Lib folders in d:\functions, d:\abc, and many other places. I want to find the latest copy of each file in those directories. So, if the file d:\functions\foo.txt was last modified on 2009-10-12 and d:\abc\foo.txt was last modified on 2009-10-13, then I want the version in d:\abc to by copied to the target directory.
I have used file::find but it searches in whole dir and copies the contents that are not latest copy.
I think you just described rsync. Unless you have some sort of weird requirements here, I don't think you need to write any code to do this. I certainly wouldn't reach for Perl to do the job you described.
You need to use File::Find to create a hash of files to move. Only put the path to a file in the hash if the file is newer than the path already stored in the hash. Here is a simple implementation. Note, there may be problems on the windows platform, I am not used to using File::Spec to work with files and pathes in a cross platform manner.
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
use File::Spec;
my %copy;
my #sources = qw{
/Users/cowens/foo/Lib
/Users/cowens/bar/Lib
/Users/cowens/baz/Lib
};
find sub {
my ($volume, $dir, $file) = File::Spec->splitpath($File::Find::name);
my #dirs = File::Spec->splitdir($dir);
my #base = ($volume); #the base directory of the file
for my $dir (#dirs) {
last if $dir eq 'Lib';
push #base, $dir;
}
#the part that is common among the various bases
my #rest = #dirs[$#base .. $#dirs];
my $base = File::Spec->catdir(#base);
my $rest = File::Spec->catfile(#rest, $file);
#if we don't have this file yet, or if the file is newer than the one
#we have
if (not exists $copy{$rest} or (stat $File::Find::name)[9] > $copy{$rest}{mtime}) {
$copy{$rest} = {
mtime => (stat _)[9],
base => $base
};
}
}, #sources;
print "copy\n";
for my $rest (sort keys %copy) {
print "\t$rest from $copy{$rest}{base}\n";
}
If you can standardize on a single location for your libraries, and then use one of the following:
set PERL5LIB Environment variable and add
use lib 'C:\Lib';
or
perl -I C:\Lib myscript
Any of these will give you a single copy of your lib directory that any of your scripts will be able to access.