I'm trying to use Archive::Zip to zip a directory but the resulting zip I get is empty.
What am I doing wrong?
my ($inDirectory, $outFile) = #_;
# Create a Zip file
my $zip = Archive::Zip->new();
# Add a directory
my $dir_member = $zip->addDirectory($inDirectory. "/");
# Save the Zip file
unless ( $zip->writeToFileNamed($outFile) == AZ_OK ) {
die 'Could not zip file';
}
Got it working , I had to use $zip->addTree
Maybe your directory $inDirectory ... is not a directory as expected and I'm not sure but it looks like you don't need the end slash for the dirname :
print $inDirectory::Find::name;
if ( -d $inDirectory::Find::name ) { # just grab directories, not files.
print "adding a dir\n";
$zip->addDirectory($inDirectory::Find::name);
} else {
#zip files
print "adding a file\n";
$zip->addFile($inDirectory::Find::name) != AZ_OK || print "couldn't add file \n";
}
Related
I tried
system("ls > file");
in my Perl script but when I open my file, it is an empty file while my directory has a list of file.
my $dirpath = "./";
my $filepath = "./file";
opendir(DIR, $dirpath) or die("Cannot open directory: $!");
open(OUT, ">$filepath");
foreach( sort readdir(DIR) ){
next if $_ =~ /^\.{1,2}$/; # to ignore "." and ".."
print(OUT "$_\n");
}
close(OUT);
closedir(DIR);
Note that if you have the output file in this directory you are listing, then it will be listed as well since you have to open it before reading the directory.
I'm trying to unzip all files in a directory using IO::Compress, but my script is failing with no error details. I used IO::Uncompress::Unzip as a reference, and it seems pretty simple, but it just dies with:
root#test:/home/user# ./unzip.pl
Its there.
unzip failed:
my $outputdir = "/tmp";
if ( <$outputdir/*.zip> ){
print "Its there.\n";
unzip '<$outputdir/*.zip>' => '<$outputdir/#1>'
or die "unzip failed: $UnzipError\n";
}
What am I doing wrong?
It took me a while to figure out the code and syntax. Basically, the syntax is:
Open the zip file.
While you read in the next file stream (nextStream).
Find the name of the file stream you're reading.
Create a new file to write to (using open or File::IO->new)
While there is data in the file stream (read)
Write to the new file's buffer.
Close the file you created.
Close the zip file.
The trick is that the two while statements will return a status of less than zero (specifically a -1) if there is a problem with the reading. They return a status of zero when they are finished. Thus, right after the while statement, you've got to check the status.
This is the code I used. Notice I don't import $UnzipError, but instead, I use the full name of the variable including it's package name.
#
# Unzip Artifact
#
my $zip_fh = IO::Uncompress::Unzip->new( $old_zip_file )
or die qq(Cannot open zip "$old_zip_file" for reading.);
#
# Go through each element in Zip file
#
while ( my $status = $zip_fh->nextStream ) {
if ( $status < 0 ) {
die qq(Error in Zip: $IO::Uncompress::Unzip::UnzipError.);
}
#
# Get name of the file you're unzipping in the zip
#
my $element_name = $zip_fh->getHeaderInfo->{Name};
next if $element_name =~ m{/$}; # Skip Directories
my $element_dir = dirname $element_name;
my $full_element_dir = File::Spec->join( $unzip_directory, $element_dir );
#
# Create the directory for the file if it doesn't exist
#
my $full_element_name = File::Spec->join( $unzip_directory, $element_name );
if ( not -d $full_element_dir ) {
make_path $full_element_dir
or die qq(Can't make directory "$full_element_dir".);
}
my $unzipped_fh = IO::File->new( $full_element_name, "w" )
or die qq(Can't open file "$full_element_name" for writing: $!);
#
# Now repeatably read the file until you've written everything
#
my $buffer;
while ( my $status = $zip_fh->read( $buffer ) ) {
if ( $status < 0 ) {
die qq(Error in Zip: $IO::Uncompress::Unzip::UnzipError.);
}
$unzipped_fh->write( $buffer );
}
$unzipped_fh->close;
}
$zip_fh->close;
You can try below
use strict ;
use warnings ;
use IO::Uncompress::Unzip qw(unzip $UnzipError) ;
for my $input ( glob "/tmp/*.zip" )
{
my $output = $input;
$output =~ s/.zip// ;
unzip $input => $output or die "Error compressing '$input': $UnzipError\n";
}
I believe the fix that was suggested by David W. 82.2k25154274 (see below) had a small bug.
Great example and I copied it, but it always ignored one file!
Fix is to initialize $status to 1 and only call next at end of loop.
Fix:
#
# Unzip Artifact
#
my $zip_fh = IO::Uncompress::Unzip->new( $old_zip_file )
or die qq(Cannot open zip "$old_zip_file" for reading.);
#
# Go through each element in Zip file
#
my $status = 1;
while ( $status ) {
if ( $status < 0 ) {
die qq(Error in Zip: $IO::Uncompress::Unzip::UnzipError.);
}
#
# Get name of the file you're unzipping in the zip
#
my $element_name = $zip_fh->getHeaderInfo->{Name};
next if $element_name =~ m{/$}; # Skip Directories
my $element_dir = dirname $element_name;
my $full_element_dir = File::Spec->join( $unzip_directory, $element_dir );
#
# Create the directory for the file if it doesn't exist
#
my $full_element_name = File::Spec->join( $unzip_directory, $element_name );
if ( not -d $full_element_dir ) {
make_path $full_element_dir
or die qq(Can't make directory "$full_element_dir".);
}
my $unzipped_fh = IO::File->new( $full_element_name, "w" )
or die qq(Can't open file "$full_element_name" for writing: $!);
#
# Now repeatably read the file until you've written everything
#
my $buffer;
while ( my $status = $zip_fh->read( $buffer ) ) {
if ( $status < 0 ) {
die qq(Error in Zip: $IO::Uncompress::Unzip::UnzipError.);
}
$unzipped_fh->write( $buffer );
}
$unzipped_fh->close;
$status = $zip_fh->nextStream; # Getting next file if any... or 0 to quit loop...
}
$zip_fh->close;
I trying to write a script that will copy files from one folder to another based on the file name(similar). As I got Few thousands text files in a folder. But I try to find few hundreds of files out of thousands files. It's takes a lot of time to search it one by one.
Copy seem like a good idea to use in this and then use for to loop through the list of files that I try to find out of thousands. But Copy need a specified name. The problem is I only have part of the file name.
Example of list of files(Content of the text file):
ABCDEF-A01
ADEWSD-B03
ABDDER-C23
Example of filename:
GGI_1409506_ABCDEF-A01.txt,GGI_ADEWSD-B03.txt,DA_ABDDER-C23_12304.txt
I only got the ABCDEF-A01 instead of the full filename.
Expected result:
Able to search through the folder and copy the files to another location that matched according the list of files (one text files).
Anything that you can share? Info/ans/related posts? Thank you so much!
Try the below code in perl . When running the program pass the arguments for Source Directory path and Destination Directory path along with the list of filename that need to be searched. If destination directory doesn't exist it will create a folder automatically through the program as shown below :
Code:
use strict;
use warnings;
use File::Copy;
my $source = $ARGV[0];
my $destination = $ARGV[1];
my $listFiles = $ARGV[2];
if(-f $destination)
{
print "Already unknown extension of file exists with the same name of directory. So rename the file and run the program";
exit 0;
}
if(-d "$destination")
{
print "Directory where files need to be copied: $destination\n";
}
else
{
print "No Directory found and hence created the directory $destination\n";
mkdir("$destination");
}
opendir DIR, $source or die "cant open dir";
my #files = grep /(.*?)(\.txt)$/,(readdir DIR);
open my $fh, '<', "$listFiles" or die "Cannot open the file names to search $listFiles - $!";
open my $out,'>', "$ARGV[1]\\NoMatch.txt" or die "Cannot write to the file NoMatch.txt - $!";
my #listFileNames = <$fh>;
my #listFiles = ();
foreach my $InputFiles (#files)
{
chomp($InputFiles);
foreach my $list(#listFileNames)
{
chomp($list);
if($InputFiles =~ /$list/isg)
{
print "Files : $InputFiles copying\t";
copy("$InputFiles","$destination");
print "Files : $InputFiles copied\n";
push(#listFiles,$list);
}
}
}
my %seen = ();
my $count = 0;
foreach my $list (#listFiles)
{
$seen{lc($list)} = 1;
#print $list . "\n";
}
foreach my $listnames (#listFileNames)
{
if($seen{lc($listnames)})
{
}
else
{
if($count ==0)
{
print "\nFilenames that did not match the text files are present in the destination folder : NoMatch.txt file " . "\n";
}
print $out "$listnames\n";
$count++;
}
}
close($out);
close($fh);
closedir(DIR);
create a batch file and put it in the source folder, with your list of files you want to copy.
for /f %%f in (list.txt) do robocopy c:\source d:\dest %%f
Hope this helps
#!/usr/bin/perl -w
use strict;
use File::Copy;
my $sorce_direcrtory = qq{};
my $new_directory = "";
opendir(my $dh, $sorce_direcrtory) || die;
while(readdir $dh) {
if($_ =~ /[A..Z]+\-[A..Z]\d+/){
move("$sorce_direcrtory/$_", "$new_directory/$_");
}
}
closedir $dh;
One wierd behaviour I am observing -- in a perl script , I checked wether a directory exists or not, if it exists - it copies a file to that directory, if it doesnt -then the directory is created followed by the file copy
When I go and check the file manually, the file is present . but when I run the same script again to copy another file using the same process as above, I see that the previous files arent present. For a confirmation , I performed a directory read in the script , it said that dir is empty.
Can anyone please help me in understanding
Please find below a code :
if (-d "/home/foo") {
print "the directory is already created \n";
$i=0;
opendir(DIR, "/home/foo") or die "Cant open /home/foo: $!\n";
#list = readdir(DIR);
foreach $line(#list) {
unless ($line =~ /^[.][.]?\z/) {
$i++;
}
}
if ($i != 0) { print "There is Stuff in here!"; }
else { print "This Dir is Empty!"; }
closedir(DIR);
}
else {
&runcond("mkdir /home/foo");
}
`cp $file /home/foo`; #Copying a file $file in the directory
`cp $file /home/foo`;
You haven't defined $file
I am writing a perl script that will zip up a group of files from a given parent folder and create a *.epub file. The process works ok, and I am able to open the epub in adobe digital editions, but I get an epubchecker error:
Required MTA-INF/container.xml resource is missing
When I zip up the files manually (I'm on a winxp machine) there are no problems, but the perl created file throws the error. Here is the relevant code:
#-------------------------------------------------------------------------------
# name : createEpub
# purpose : create an epub from a given parent folder
# args : [0] parent folder [1] name of new zip file [2] log object
# example : &createEpub( $zipLoc, 'newzip', $log);
# notes : it is assumed that mimetype, meta-inf and oebs are all child folders
# of the given parent folder
# author: : jw 2/4/13
#-------------------------------------------------------------------------------
sub createEpub(){
my ($parentFolder, $zipName, $log) = #_;
my $newZipLoc;
$parentFolder =~ s#\\#/#g;
my $newZip = Archive::Zip->new();
# add mimetype first with no compression
my $mimetype = "$parentFolder/mimetype";
my $mimetypeMember = $newZip->addFile( $mimetype, 'mimetype');
$mimetypeMember->desiredCompressionMethod( COMPRESSION_STORED );
## add web-inf
my $metaINF = $parentFolder . '/META-INF';
&addFilesToZip( $metaINF, $parentFolder, $newZip, $log);
## add OEBPS
my $oebps = $parentFolder . '/OEBPS';
&addFilesToZip( $oebps, $parentFolder, $newZip, $log );
# maybe break this out in its own func...ok for current epub script purposes
$newZipLoc = $1 if $parentFolder =~ m/(.*)\//;
$newZipLoc = $newZipLoc . '/' . $zipName;
if( $newZipLoc !~ m/\.zip/){
$newZipLoc = $newZipLoc . '.epub';
}
$log->info("writing new zip file to $newZipLoc");
$newZip->writeToFileNamed( $newZipLoc );
## not sure if this is the write thing to do...returning actual file name, not zip extract object
return $newZipLoc;
}
sub addFilesToZip(){
my ($file, $origParent, $zip, $log) = #_;
if( -d $file ){
my #children = grep{ $_ !~ m/mimetype/} glob("$file/*") or warn "can't add $file to zip! $!\n";
foreach my $child( #children ){
&addFilesToZip( $child, $origParent, $zip, $log);
}
} elsif (-f $file){
my $memPath = $file; $memPath =~ s/\Q$origParent\E//;
$log->info("adding member $memPath");
my $newMember = $zip->addFile( $file, $memPath );
}
}
when I open the resulting epub file in winzip, the container.xml is definitely there, I also made sure the mimetype is first with no compression. Here's an excerpt from the log:
-------------------------------------------------------------------------
creating zip file from recently unzipped files
-------------------------------------------------------------------------
[ok]: adding member /META-INF/container.xml
[ok]: adding member /META-INF/stylesheet.css.kindle
[ok]: adding member /META-INF/toc.ncx.kindle
[ok]: adding member /OEBPS/content.opf
[ok]: adding member /OEBPS/coverpage.html
In the googling I've seen there is a slight alteration people make in their linux shell commands, but I didn't see anything related to archive::zip or win.
thanks,
bp
From your logging it looks like you are creating entries in the zip file with absolute paths.
[ok]: adding member /META-INF/container.xml
I believe epub files need to be relative paths - try removing the leading "/" from the path that is going to be written to the zip file. Something like ths (untested)
} elsif (-f $file){
my $memPath = $file; $memPath =~ s/\Q$origParent\E//;
# remove leading "/"
$memPath =~ s#^/+##;
$log->info("adding member $memPath");
my $newMember = $zip->addFile( $file, $memPath );
}