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.
Related
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');
I want to copy the folder from one directory to another.
For Example
I have folder in D drive like Sample it that itself contain many folder.I want to copy this sample folder with its sub folders to some other drive.Here i have done something but it copies only the files.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Copy,
my $source_dir = "aa";
my $target_dir = "bb";
opendir(my $DIR, $source_dir) || die "can't opendir $source_dir: $!";
my #files = readdir($DIR);
foreach my $t (#files)
{
if(-f "$source_dir/$t" ) {
#Check with -f only for files (no directories)
copy "$source_dir/$t", "$target_dir/$t";
}
}
closedir($DIR);
Please help with this...
Thanks in advance
You need to use either the File::Copy::Recursive module, which has a number of related functions from which you probably want dircopy; or the File::Mirror module, which has a mirror function that does the same as dircopy, plus a recursive function that allows you to provide a block of code to control exactly how the nodes will be copied.
use strict;
use warnings;
use File::Copy::Recursive qw(dircopy);
dircopy($source_dir,$target_dir) or die("$!\n");
I have a Perl program to read .html's and only works if the program is in the same directory as the .html's.
I would like to be able to start in different directories and pass the html's location as a parameter. The program (shell example below) traverses the subdirectory "sub"
and its subdirectories to look for .html's, but only works when my perl file is in the same subdirectory "sub". If I put the Perl file
in the home directory, which is one step back from the subdirectory "sub", it doesn't work.
In the shell, if I type "perl project.pl ./sub" from my home directory, it says could
not open ./sub/file1.html. No such file or directory. Yet the file does exist in that exact spot.
file1.html is the first file it is trying to read.
If I change directories in the shell to that subdirectory and move the .pl file
there and then say in the shell: "perl project.pl ./" everything is ok.
To search the directories, I have been using the File::Find concept which I found here:
How to traverse all the files in a directory; if it has subdirectories, I want to traverse files in subdirectories too
Find::File to search a directory of a list of files
#!/usr/bin/perl -w
use strict;
use warnings;
use File::Find;
find( \&directories, $ARGV[0]);
sub directories {
$_ = $File::Find::name;
if(/.*\.html$/){#only read file on local drive if it is an .html
my $file = $_;
open my $info, $file or die "Could not open $file: $!";
while(my $line = <$info>) {
#perform operations on file
}
close $info;
}
return;
}
In the documentation of File::Find it says:
You are chdir()'d to $File::Find::dir when the function is called,
unless no_chdir was specified. Note that when changing to directories
is in effect the root directory (/) is a somewhat special case
inasmuch as the concatenation of $File::Find::dir, '/' and $_ is not
literally equal to $File::Find::name.
So you actually are at ~/sub already. Only use the filename, which is $_. You do not need to overwrite it. Remove the line:
$_ = $File::Find::name;
find changes directory automatically so that $File::Find::name is no longer relative to the current directory.
You can delete this line to get it to work:
$_ = $File::Find::name;
See also File::Find no_chdir.
From the File::Find documentation:
For each file or directory found, it calls the &wanted subroutine.
(See below for details on how to use the &wanted function).
Additionally, for each directory found, it will chdir() into that
directory and continue the search, invoking the &wanted function on
each file or subdirectory in the directory.
(emphasis mine)
The reason it's not finding ./sub/file1.html is because, when open is called, File::Find has already chdired you into ./sub/. You should be able to open the file as just file1.html.
I want to locate the latest subdirectory on a network path and copy the entire contents of the latest subdirectory into another folder in the network path
We have lot of subfolders under the folder \\10.184.132.202\projectdump I need to sort the sub folders to get into latest folder and copy the entire contents into another folder on \\10.184.132.203\baseline
I am using the below mentioned script i am able to list the latest modified folder under the directory but I am unaware of copying the contents.
use File::stat;
use File::Copy qw(copy);
$dirname = '\\\\10.184.132.202\\projectdump\\Testing\\';
$destination = '\\\\10.184.132.203\\baseline\\Testing\\';
$timediff=0;
opendir DIR, "$dirname";
while (defined ($sub_dir = readdir(DIR)))
{
if($sub_dir ne "." && $sub_dir ne "..")
{
$diff = time()-stat("$dirname/$sub_dir")->mtime;
if($timediff == 0)
{
$timediff=$diff;
$newest=$sub_dir;
}
if($diff<$timediff)
{
$timediff=$diff;
$newest=$sub_dir;
}
}
}
print $newest,"\n";
open my $in, '<', $newest or die $!;
while (<$in>) {
copy *, $destination; --------> Here i want to copy the entire contents of the $newest to $destination.
}
Use File::Copy::Recursive. This is an optional module, but allows you to copy entire directory trees. Unfortunately, File::Copy::Recursive is not a standard Perl module, but you can install it via the cpan command.
If installing modules is a problem (sometimes it is), you can use the File::Find to go through the directory tree and copy files one at a time.
By the way, you can use forward slashes in Perl for Windows file names, so you don't have to double up on backslashes.
Why don't call a simple shell cmd to find the latest dir?
I think, this will be much simpler in shell...
my $newestdir=`ls -1rt $dirname|tail -n 1`;
in shell:
LATESTDIR=`ls -1rt $dirname|tail -n 1`
cp -r ${LATESTDIR}/* $destination/
Ups, I just realized that you might using Windows...
Get all dirs and their times into a hash then sort that hash reverse order to find the newest one
my ($newest) = sort {$hash{$b} cmp $hash{$a} keys %hash;
then
opendir NDIR, "$newest";
while ($dir=<NDIR>) {
next if $dir eq '.' or $dir eq '..';
copy $dir, $destination;
}
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.