How to recursively copy with wildcards in perl? - perl

I've modified some script that I've written to now only copy .jpg files.
The script seems to work. It will copy all of the .jpg files from one folder to another but the script is meant to continually loop every X amount of seconds.
If I add a new .jpg file to the folder I'm moving items from after I have already started the script it will not copy over the newly added file. If I stop and restart the script then it will copy the new .jpg file that was added but I want the script to copy items as they are put into the folders and not have to stop and restart the script.
Before I added the glob function trying to only copy .jpg files the script would copy anything in the folder even if it was moved into the folder while the script was still running.
Why is this happening? Any help would be awesome.
Here is my code:
use File::Copy;
use File::Find;
my #source = glob ("C:/sorce/*.jpg");
my $target = q{C:/target};
while (1)
{ sleep (10);
find(
sub {
if (-f) {
print "$File::Find::name -> $target";
copy($File::Find::name, $target)
or die(q{copy failed:} . $!);
}
},
#source
);
}

Your #source array contains a list of file names. It should contain a list of folders to start your search in. So simply change it to:
my $source = "C:/source";
I changed it to a scalar, because it only holds one value. If you want to add more directories at a later point, an array can be used instead. Also, of course, why mix a glob and File::Find? It makes little sense, as File::Find is recursive.
The file checking is then done in the wanted subroutine:
if (-f && /\.jpg$/i)

It won't refresh its list of files if you only glob the list once.
I prefer to use File::Find::Rule, and would use that for each iteration on the directory instead to update the list.
use File::Find::Rule;
my $source_dir = 'C:/source';
my $target_dir = 'C:/target';
while (1) {
sleep 10;
my #files = File::Find::Rule->file()
->name( '*.jpg' )
->in( $source_dir );
for my $file (#files) {
copy $file, $target
or die "Copy failed on $file: $!";
}
}

Related

making new directory in perl

I want to create a directory with a certain name before the beginning of a method. At each iteration the directory should be replaced with new entries instead of getting appended.
I have used this code:
sub makingDirectoryForClient {
$nameOfTheClientDirectory = $_[0];
my $directory = "D:\\ATEF\\clientfolder\\$nameOfTheClientDirectory";
my $outputvar = mkdir $directory;
}
but still the folder is not getting replaced. Any ideas?
If mkdir appears to be doing nothing then you should code a warning statement to find out why. The reason for failure will be in built-in variable $!, so I suggest you write your subroutine like this
sub make_client_dir {
my $client_dir = shift;
my $path = "D:\\ATEF\\clientfolder\\$client_dir";
( my $success = mkdir $path ) or
warn qq{Unable to create directory "$path": $!};
return $success;
}
Note that I've also modified your code to be more idiomatic
I needed to create a directory of the same name that already existed since I thought that would replace the folder with a new empty folder. But Perl does not work that way: mkdir will not work if a folder of the same name already exists.
So I first deleted the directory using rmtree from File::Path and then created a new directory of the same name.

Perl File::Copy is not actually copying the file

Quick synopsis: Let's say there are multiple of the same file type in one directory (in this example, 10 .txt files). I am trying to use Perl's copy function to copy 5 of them into a new directory, then zip up that directory.
The code works...except the folder that is supposed to have the .txt files copied, doesn't actually have anything in it, and I don't know why. Here is my complete code:
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy;
my $source_dir = "C:\\Users\\user\\Documents\\test";
my $dest_dir = "C:\\Users\\user\\Desktop\\files";
my $count = 0;
opendir(DIR, $source_dir) or die $!;
system('mkdir files');
while (my $file = readdir(DIR)) {
print "$file\n";
if ($count eq 5) {
last;
}
if ($file =~ /\.txt/) {
copy("$file", "$dest_dir/$file");
$count++;
}
}
closedir DIR;
system('"C:\Program Files\Java\jdk1.8.0_66\bin\jar.exe" -cMf files.zip files');
system('del /S /F /Q files');
system('rmdir files');
Everything works...the directory files is created, then zipped up into files.zip...when I open the zip file, the files directory is empty, so it's as if the copy statement didn't copy anything over.
In the $source_dir are 10 .txt files, like this (for testing purposes):
test1.txt
test2.txt
test3.txt
test4.txt
test5.txt
test6.txt
test7.txt
test8.txt
test9.txt
test10.txt
The files don't actually get copied over...NOTE: the print "$file\n" was added for testing, and it indeed is printing out test1.txt, test2.txt, etc. up to test6.txt so I know that it is finding the files, just not copying them over.
Any thoughts as to where I'm going wrong?
I think there is a typo in your script:
system('mkdir files');
should be:
system("mkdir $dest_dir");
but, the real issue is that you are not using the full path of the source file. Change your copy to:
copy("$source_dir/$file", $dest_dir);
and see if that helps.
You might also want to look at: File::Path and Archive::Zip, they would eliminate the system calls.

Trying to pass a subdirectory as a parameter in Perl

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.

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.

Perl - locate the latest subdirectory on a network path and copy the entire contents

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;
}