|
Bama_Perl has asked for the wisdom of the Perl Monks concerning the following question:
Hi Monks,
I need some wisdom with how to quickly and easily set up a for loop. Here's what I want to do. I have multiple directories, and within each of these directories, there is either a file with a certain extension, say *.txt, or there is not. What I need to do is loop through each of these directories to check if the file that has a *.txt extension exists, and if that file does exist, I need to copy another file within that directory -- let's call that file $out. Here's my code setup:
#!/usr/bin/perl
use warnings;
$out = "outFile";
$newdir = $newdirectory;
open(TABLEA, "dirlist");
@tablea = <TABLEA>;
foreach $dir (@tablea) {
chdir $dir;
if (glob("*.txt")) {
system("mv $out $newdir");
}
}
So, the directory list is set as an array, @tablea, and each directory is called $dir. If the file w/ extension *.txt exists, mv the $out file (within that directory) to the new directory, $newdir. Repeat the check for each directory.
If run this script, nothing gets sent to new directory, so I was wondering how I could improve this script so that this script runs correctly?
Thanks.
|
Re: Check if file exists in multiple directories
by dasgar (Priest) on May 21, 2015 at 19:27 UTC
|
I'm not sure if you wanting to copy or move a file. You have stated both - sometimes within the same post. For example, in Re^4: Check if file exists in multiple directories you initially say that you want to copy the file and then two sentences later you say that you want to move the file. And there is a significant difference between copying a file and moving a file.
In either case, I'm seeing one potential issue. For example, if there are 4 directories with a *.txt file and you copy/move 'file.out' from each one to the same new directory, you'll be overwriting the file in the new directory 3 times.
I kind of agree with most of 2teez's suggestions. Based on my understanding of what you're trying to do, here's my approach using File::Find::Rule and Path::Tiny. (NOTE: Both modules are not core modules and would need to be installed from CPAN. Also, I did not test the code below, so there's a chance there could be mistakes in it that I missed.)
use strict;
use warnings;
use File::Find::Rule;
use Path::Tiny;
my @dirs; # populate with list of directories to search
my $rule = File::Find::Rule->new;
$rule->file; # find only files
$rule->name(qr/\.txt$/i); # find (case-insensitive) filenames ending w
+ith .txt
$rule->extras({no_chdir => 1}); # don't change directories during sear
+ch
my @files = $rule->in(@dirs);
foreach my $file (@files) {
my $source_dir = path($file)->parent->stringify;
my $target_dir; # set this to path of target directory
my $outfile; # set to name of file to copy/move out of source dire
+ctory
my $source_file = path($source_dir,$outfile);
my $target_file = path($target_dir,$outfile);
# to copy the file, uncomment next line
#path($source_file)->copy($target_file);
# to move the file, uncomment next line
#path($source_file)->move($target_file);
}
| [reply]
[d/l] |
Re: Check if file exists in multiple directories
by hdb (Monsignor) on May 21, 2015 at 17:57 UTC
|
At a first glance, your logic says if in the directory there is a .txt file, then move a file called "outFile" to the directory. Is that what you want?
| [reply] |
|
|
Yes if there is a .txt file, move the file called outFile to the new directory. Correct.
| [reply] |
|
|
Hi Bama_Perl,
What I don't understand is do you want the file "outFile" moved or copied? Because, if you move it to say the first directory that has '*.txt', what happens to another say "fourth" directory that also has '*.txt'?
Secondly, I think you should be using a perl core module like File::Copy to achieve your aim instead of using mv command in system like you are doing.
Third, you may use File::Find module to do the searching of directories for you.
Lastly, use three arguments open function and a lexical scoped file-handler (this is an old wisdom that still holds true in a way today)
If you tell me, I'll forget.
If you show me, I'll remember.
if you involve me, I'll understand.
--- Author unknown to me
| [reply] |
|
|
|
|
| [reply]
[d/l]
[select] |
|
|
|
|
Re: Check if file exists in multiple directories
by FreeBeerReekingMonk (Deacon) on May 21, 2015 at 18:45 UTC
|
Change this:
system("mv $out $newdir");
To this:
$errormessage = `/bin/mv "$out" "$newdir" 2>&1`;
if($?){
warn "Error($?) There was a problem "
. "copying '$out' to '$newdir': $! \n $errormessage\n";
}
| [reply]
[d/l]
[select] |
|
|
Change this:
system("mv $out $newdir");
To this:
$out = `/bin/mv "$out" "$newdir" 2>&1`;
Please DON'T!
Don't mess with the shell at all. You simply can't write robust code that way. Shells behave far too different on different systems.
(Apart from that, this code breaks when $out or $newdir contains double quotes. Yes, those characters are legal in filenames. Only NUL (chr(0)) and / are not allowed. This code also breaks when $out or $newdir contains $, due to the double quotes passed to the shell. Single quotes would have prevented that, but then filenames better don't contain single quotes.)
Better ways, ordered from worst to best:
- Invoke /bin/mv via Safe Pipe Opens, using open(HANDLE,'-|') and exec('/bin/mv',$out,$newdir) as documented. This avoids all shell issues, but still lacks a sane error reporting. /bin/mv writes to STDERR, perhaps also to STDOUT, and that output depends very much on the system and the system settings. Both rename() and File::Copy::move() below report errors by returning a false value, the actual error is stored in $!, no matter how the system is configured.
You need about 20 lines of code for this, most copied from perlipc.
- Simply use Perl's rename function. Note that rename() may fail when crossing filesystem boundaries. So you may need to add some fallback code for that case IF source and destination directory may be on different filesystems. Also note that the second argument often has to be a filename if the first argument is a filename, i.e. you can't rename a file to a directory. So you may need to extract the name part from the first argument and append it to the second argument.
One line of code for the trivial case, about 10 lines of code for handling rename($file,$directory) correctly, about 200 lines of code (see source of File::Copy) for fallback code and OS specific issues. Falback code may be much shorter (about 20 lines of code) if you write for only a single OS, omit many sanity checks, and ignore many special cases and file permissions.
- Use the File::Copy module. It provides a move() function (also available as mv()) that actually behaves very much like /bin/mv: It can rename even across filesystem boundaries and allows move($file,$directory). Actually, move() IS just rename() plus the fallback code and filename handling code that you would need to write. File::Copy also knows the required OS specific workarounds. File::Copy is part of the perl core distribution, i.e. it is installed with perl and thus available without extra steps.
Two line of code for all cases, all operating systems:
use File::Copy qw( move );
move($source,$destination) or die "Can't move '$source' to '$destinati
+on': $!";
Alexander
--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
| [reply]
[d/l]
[select] |
|
|
Ahh... passionate, perfect error-free 'not throw away' code. Rich, meaningful explanation. You have my vote, sir.
| [reply] |
|
|
die "Punct filename is bad, mmkay" if $file =~ m{\p{Punct}} ;
| [reply] |
|
|
|
|
