Zipping a file with a new path - perl

I have the following directory tree:
mydir/
mydir/bbb/
mydir/bbb/ccc/
mydir/bbb/ccc/myfile.txt
The file zips as follows:
bbb\ccc\myfile.txt
I want it to appear as
\ddd\myfile.txt
The command-line zip utility does not seem to have option. Is there another way, perhaps using Perl. I'm using a unix system.

If I understand you correctly then it looks like the Archive::Zip module will do what you need.
Once you have created an archive, you can use addFile to add an archive member whose path is different from the source. Like this
$zip->addFile( {
filename => 'mydir\bbb\ccc\myfile.txt',
zipName => 'ddd\myfile.txt',
} );
For instance, this program creates a zip archive and adds the contents of the current script (defined by $0) as a member called ddd\current.pl. The archive is then written to a file called current.zip. If you open that file using 7-Zip or similar then you will see ddd\current.pl.
use strict;
use warnings;
use Archive::Zip;
my $zip = Archive::Zip->new;
$zip->addFile( {
filename => $0,
zipName => 'ddd\current.pl',
} );
$zip->writeToFileNamed('current.zip');

Related

Accessing a specific file in zipped folder using perl (perl module)

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;

PERL - renaming a file member in zip64 archive

I am changing a PERL code that does compression to be able to handle the zip64 extension.
the old code is using Archive::Zip module that can be used as follows.
# Create a Zip file
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
my $zip = Archive::Zip->new();
# Add a file from disk
my $file_member = $zip->addFile( 'xyz.pl', 'AnotherName.pl' );
Archive::Zip doesn't support zip64 extension and because of that I am using IO::Compress::Zip module instead.
I am looking for a way to mimic the addfFile functionality some way or another, renaming while zipping or maybe editing the archives after zipping.
I can't find any PERL module that can help me in doing so.
Is there any way in PERL to do that ?
In case there is not a direct way, can I change something in the
header of the archive file to rename its members ?
Thank you
I assume this is the same question you asked over on PerlMonks Renaming a file member in zip64 archive?
If so, here is the same reply.
Try this - it will automatically create the output file as a Zip64 compliant Zip archive if required (i.e. if the size exceed 4 Gig or you have > 64k members in the zip archive). Otherwise it creates a standard Zip archive.
use Archive::Zip::SimpleZip qw($SimpleZipError) ;
my $z = new Archive::Zip::SimpleZip "my1.zip"
or die "Cannot create zip file: $SimpleZipError\n" ;
$z->add('xyz.pl', Name => 'AnotherName.pl' );
$z->close();
If you want to force the creation of a Zip64 archive (even when the archive is small enough not to need it) add the Zip64 option when creating the Archive::Zip::SimpleZip object, like this
my $z = new Archive::Zip::SimpleZip "my1.zip", Zip64 => 1
or die "Cannot create zip file: $SimpleZipError\n" ;
I am not sure if there is a way to do it with IO::Compress::Zip, but.
Why do not you rename files before adding them to archive?
If you need to preserve original files with its names, copy the files to some temp folder, rename, and to archive and delete from temp after.

How to create zip file in perl?

Hi friends i can create a zip file using files which is there in the directory where the script is currently running now i want to create zip file from various directory can anybody help me?
my code is;
use IO::Compress::Zip qw(:all);
zip [ glob("inventory_report_for_neus.xls") ] => "my.zip"
or die "Cannot create zip file: $ZipError" ;
this will produce zip file with specific files but
use IO::Compress::Zip qw(:all);
zip [ glob("..\\inventory_report_for_neus.xls") ] => "my.zip"
or die "Cannot create zip file: $ZipError" ;
this is also produce zip file but there is no file inside!
Updated
IO::Compress::Zip creates a zip file with a hierarchical structure based on the original locations of the files within the current directory.
However, a result of this is that it does not correctly handle files that are not enclosed by the current working directory.
The simplest solution is probably to change directories to the parent directory before zipping. If that is not an option, copy the files to a temporary location before zipping, or possibly use IO::Compress::Zip's more advanced features, like writing the zip file from a filehandle.
friends finally i found solution for this case..simply i've used shell command inside perl so i'll create zip file with appropriate files...code as follows.
use strict;
use warnings;
use MIME::Lite;
use Net::SMTP;
my $msg = MIME::Lite->new (
From => 'xyz#gmail.com',
To => 'thiyagu040#gmail.com',
Subject => 'with inline images',
Type =>'multipart/mixed'
) or die "Error creating mult;$!\n";
system("zip test.zip '../test_dir/report.xls'");
.
.
.
.
$msg ->( filename => test.zip,
content_type => 'application/zip',
disposition => 'attachment',
name => $filename,
);
MIME::Lite->send('smtp', 'smtp.gmail.com', Timeout=>60,AuthUser=>'xyz', AuthPass=>'remotecontrol');
$msg->send();

Perl Rar a whole folder

I want to rar a whole folder with Perl and Archive::Rar. For example the folder /root/pictures.
I have found only a way to rar single files.
I tried to find all files in the folder and rar them, but then I always have the whole path sticking to them (/root/pictures) in the rar archive.
I want only the /pictures folder plus its contents. Is that possible?
The folder structure of the files stored in the archive will be the same as the file names that you pass to the Add method. (Although you can add them without any containing folder at all using the -excludepaths option.)
If you chdir to the \root directory before adding the files to the archive, and specify all your files as pictures\file1.jpg etc. then the result should be as you want.
Something like this
use strict;
use warnings;
use Archive::Rar;
use autodie;
chdir '\root';
my $rar = Archive::Rar->new(-archive => 'pictures.rar');
$rar->Add(-files => [ glob 'pictures\*' ]);
Clearly you could add a path to the rar file name if you want the archive stored elsewhere.
At first you have to get a list of files from defined directory:
use File::Find;
my #content;
find( \&wanted, '/some/path');
sub wanted {
push #content, $File::Find::name;
return;
}
After that you may use the Archive::Rar to pack it.
use Archive::Rar;
my $rar = Archive::Rar->new();
$rar->Add(
-size => $size_of_parts,
-archive => $archive_filename,
-files => \#content,
);

How can I sync two directories with Perl?

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.