Perl Rar a whole folder - perl

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,
);

Related

Zipping a file with a new path

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');

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.

recursively file delete from directory in perl

I am new in perl script. I want to write perl which delete previous backup file and extract new backup file from dropbox and rename with specific file name.
Example:
backup location:
D:\Database\store_name\ containing .bak files
Actual folder data
D:\Database\Mahavir Dhanya Bhandar\ contain .bak file
D:\Database\Patel General Store\ containg .bak files
..so on
How can write perl script code which delete *.bak files store_recursively
2.extract new backup file from dropbox and rename with specific file name.
Have you looked into walking your file tree. http://rosettacode.org/wiki/Walk_a_directory/Recursively. Combine this with simple file operations (copying, deleting, etc.) and you should be good.
use File::Find qw(find);
my $dir = "D:\Database\Store_Name";
find sub {unlink $File::Find::name if /\.bak$/}, $dir;
and assuming that connectToDropbox() connects to your dropbox
use File::Copy;
use File::Find qw(find);
my $backup = connectToDropbox();
my $dir = "D\Database\Store_Name";
find sub {copy($backup -> getFile("file"), "newFile")} $dir;
of course, this assumes that you already can set up a connection and such to Dropbox. If not, there is a good CPAN libraryhere you can check out.

Moving files into different folders/directories based on their name

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.

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.