I am trying to copy zipped files which are stored in one directory to another folder by matching there names.
Below image are the folder names which is the input for my program.
From this list i am taking only "Sample_51" folder , inside this folder i have Zipped files like below,
Now i need to copy all "R1" name files to R1 folder and all "R2" named files to R2 folder.
Below i have tried to do so , help me out to do as explained above,
#! use/bin/perl
print "Enter Folder name \n";
print "File name: ";
chomp( my $Filename = <> );
system("mkdir R1");
system("mkdir R2");
opendir( DIR, "$Filename" ) or die "cannot open directory";
foreach my $name ( readdir(DIR) ) {
next if ( $name =~ /^\./ );
next if ( $name =~ /^\.\./ );
if ( $Filename =~ /\S+(R\d)/ ) {
system("cp -r $Filename R1");
}
else {
system("cp -r $Filename R2");
}
}
After copying this one more step is there, than i will update after fixing this issue,
thanks in advance
Use File::Copy to copy the files. As #sobrique said $Filename =~ /\S+(R\d) it matches any digit followed by R.But I guess you are intersted in R1 and R2 only. Try this:
#!/usr/bin/perl
use File::Copy;
use strict;
use warnings;
print"Enter Folder name \n";
print"File name: ";
chomp(my $Filename=<>);
mkdir "R1";
mkdir "R2";
opendir(DIR,"$Filename") or die "cannot open directory";
foreach my $name (readdir(DIR))
{
next if ($name =~ /^\./);
if($name =~ /R1/) { #compare $name not $Filename
copy("$Filename/$name", "R1"); # copy the file from folder to R1 directory
}
elsif($name =~ /R2/){
copy("$Filename/$name","R2"); ## copy the file from folder to R2 directory
}
}
I think your problem is this line:
if ( $Filename =~ /\S+(R\d)/ ) {
Because what it's matching is R followed by any digit. So will be true for files called R1, R2, R9 or indeed R99999
You need to capture the result of that regular expression match. (By the way - an unanchored \S+ isn't going to do much in this example either. That just means 'one or more non spaces' before the R.
How about:
if ( my ( $R_Num ) = ( $Filename =~ /_(R\d+)_/ ) {
print "R number is $R_Num\n";
}
Because then you can work based on what that's set to (and if the match fails, the if will test false).
Related
I am using next if $file eq '.' $file eq '..'; to find the file in the directory and subdirectory(except few directories) and opening the files for find and replacement. But when I have dot in folder name, it consider the folder as a file and says can't open. I filtered the files using -f but it missing to show the files in the main folder.
Is there any recursive way to find the folder and files even it has dot.
opendir my $dh, $folder or die "can't open the directory: $!";
while ( defined( my $file = readdir( $dh ) ) ) {
chomp $file;
next if $file eq '.' $file eq '..';
{
if ( $file ne 'fp' ) {
print "$folder\\$file";
if ( $file =~ m/(.[^\.]*)\.([^.]+$)/ ) {
...
}
}
}
}
You could use File::Find or File::Find::Rule as suggested by Sobrique.
It's very easy to use:
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
sub process_file {
next if (($_ eq '.') || ($_ eq '..'));
if (-d && $_ eq 'fp'){
$File::Find::prune = 1;
return;
}
print "Directory: $_\n" if -d;
print "File: $_\n" if -f;
#Do search replace operations on file below
}
find(\&process_file, '/home/chankeypathak/Desktop/test.folder'); #provide list of paths as second argument.
I had below file structure.
test.folder/test.txt
test.folder/sub.folder
test.folder/sub.folder/subfile.txt
test.folder/fp
test.folder/fp/fileinsidefp.txt
And I got below output
$ perl test.pl
File: test.txt
Directory: sub.folder
File: subfile.txt
Yes. Use File::Find::Rule
foreach my $file ( File::Find::Rule->file()->in( "." ) ) {
}
... and that's about it. You've got options for pretty much all the 'filetest' flags, so file() for -f or readable() for -r.
I have a program that takes directory name as input from user and searches all files inside the directory and prints the contents of file. Is there any way so that I can read the extension of file and read the contents of file that are of specified extension? For example, it should read contents of file that is in ".txt" format.
My code is
use strict;
use warnings;
use File::Basename;
#usr/bin/perl
print "enter a directory name\n";
my $dir = <>;
print "you have entered $dir \n";
chomp($dir);
opendir DIR, $dir or die "cannot open directory $!";
while ( my $file = readdir(DIR) ) {
next if ( $file =~ m/^\./ );
my $filepath = "${dir}${file}";
print "$filepath\n";
print " $file \n";
open( my $fh, '<', $filepath ) or die "unable to open the $file $!";
while ( my $row = <$fh> ) {
chomp $row;
print "$row\n";
}
}
To get just the ".txt" files, you can use a file test operator (-f : regular file) and a regex.
my #files = grep { -f && /\.txt$/ } readdir $dir;
Otherwise, you can look for just text files, using perl's -T (ascii-text file test operator)
my #files = grep { -T } readdir $dir;
Otherwise you can try even this:
my #files = grep {-f} glob("$dir/*.txt");
You're pretty close here. You have a main loop that looks like this:
while ( my $file = readdir(DIR) ) {
next if $file =~ /^\./; # skip hidden files
# do stuff
}
See where you're skipping loop iterations if the filename starts with a dot. That's an excellent place to put any other skip requirements that you have - like skipping files that don't end with '.txt'.
while ( my $file = readdir(DIR) ) {
next if $file =~ /^\./; # skip hidden files
next unless $file =~ /\.txt$/i; # skip non-text files
# do stuff
}
In the same way as your original test checked for the start of the string (^) followed by a literal dot (\.), we're now searching for a dot (\.) followed by txt and the end of the string ($). Note that I've also added the /i option to the match operator to make the match case-insensitive - so that we match ".TXT" as well as ".txt".
It's worth noting that the extension of a file is a terrible way to work out what the file contains.
Try this. Below code gives what you expect.
use warnings;
use strict;
print "Enter the directory name: ";
chomp(my $dir=<>);
print "Enter the file extension type: "; #only type the file format. like txt rtf
chomp(my $ext=<>);
opendir('dir',"$dir");
my #files = grep{m/.$ext/g} readdir('dir');
foreach my $ech(#files){
open('file',"$dir/$ech");
print <file>;
}
I'm store the all file from the particular directory to store the one array and i get the particular file format by using the grep command. Then open the files into the foreach condition
So I have a program that I want to clean some text files. The program asks for the user to enter the full pathway of a directory containing these text files. From there I want to read the files in the directory, print them to a new file (that is specified by the user), and then clean them in the way I need. I have already written the script to clean the text files.
I ask the user for the directory to use:
chomp ($user_supplied_directory = <STDIN>);
opendir (DIR, $user_supplied_directory);
Then I need to read the directory.
my #dir = readdir DIR;
foreach (#dir) {
Now I am lost.
Any help please?
I'm not certain of what do you want. So, I made some assumptions:
When you say clean the text file, you meant delete the text file
The names of the files you want to write into are formed by a pattern.
So, if I'm right, try something like this:
chomp ($user_supplied_directory = <STDIN>);
opendir (DIR, $user_supplied_directory);
my #dir = readdir DIR;
foreach (#dir) {
next if (($_ eq '.') || ($_ eq '..'));
# Reads the content of the original file
open FILE, $_;
$contents = <FILE>;
close FILE;
# Here you supply the new filename
$new_filename = $_ . ".new";
# Writes the content to the new file
open FILE, '>'.$new_filename;
print FILE $content;
close FILE;
# Deletes the old file
unlink $_;
}
I would suggest that you switch to File::Find. It can be a bit of a challenge in the beginning but it is powerful and cross-platform.
But, to answer your question, try something like:
my #files = readdir DIR;
foreach $file (#files) {
foo($user_supplied_directory/$file);
}
where "foo" is whatever you need to do to the files. A few notes might help:
using "#dir" as the array of files was a bit misleading
the folder name needs to be prepended to the file name to get the right file
it might be convenient to use grep to throw out unwanted files and subfolders, especially ".."
I wrote something today that used readdir. Maybe you can learn something from it. This is just a part of a (somewhat) larger program:
our #Perls = ();
{
my $perl_rx = qr { ^ perl [\d.] + $ }x;
for my $dir (split(/:/, $ENV{PATH})) {
### scanning: $dir
my $relative = ($dir =~ m{^/});
my $dirpath = $relative ? $dir : "$cwd/$dir";
unless (chdir($dirpath)) {
warn "can't cd to $dirpath: $!\n";
next;
}
opendir(my $dot, ".") || next;
while ($_ = readdir($dot)) {
next unless /$perl_rx/o;
### considering: $_
next unless -f;
next unless -x _;
### saving: $_
push #Perls, "$dir/$_";
}
}
}
{
my $two_dots = qr{ [.] .* [.] }x;
if (grep /$two_dots/, #Perls) {
#Perls = grep /$two_dots/, #Perls;
}
}
{
my (%seen, $dev, $ino);
#Perls = grep {
($dev, $ino) = stat $_;
! $seen{$dev, $ino}++;
} #Perls;
}
The crux is push(#Perls, "$dir/$_"): filenames read by readdir are basenames only; they are not full pathnames.
You can do the following, which allows the user to supply their own directory or, if no directory is specified by the user, it defaults to a designated location.
The example shows the use of opendir, readdir, stores all files in the directory in the #files array, and only files that end with '.txt' in the #keys array. The while loop ensures that the full path to the files are stored in the arrays.
This assumes that your "text files" end with the ".txt" suffix. I hope that helps, as I'm not quite sure what's meant by "cleaning the files".
use feature ':5.24';
use File::Copy;
my $dir = shift || "/some/default/directory";
opendir(my $dh, $dir) || die "Can't open $dir: $!";
while ( readdir $dh ) {
push( #files, "$dir/$_");
}
# store ".txt" files in new array
foreach $file ( #files ) {
push( #keys, $file ) if $file =~ /(\S+\.txt\z)/g;
}
# Move files to new location, even if it's across different devices
for ( #keys ) {
move $_, "/some/other/directory/"; || die "Couldn't move files: $!\n";
}
See the perldoc of File::Copy for more info.
i'm trying to write a script which would process certain files. The data are organized like this: there is a folder (let's call it X) where my script will be placed. In this same folder there is a subfolder called 'data'. This contains several more subfolders with various names and each of these contains many files (no other subfolders, just files). I need to process all files in a subfolder (more specifically, run a function on each file) and then merge the results for all files in the subfolder, so for each folder there is one result (no matter how many files it contains).
The problem is, i'm not able to get to the files so i could run my function on them. What i have now is this:
$dirname = "data";
opendir ( DIR, $dirname ) || die "Error in opening dir $dirname\n";
while( ($dirname2 = readdir(DIR)) )
{
next if $dirname2 eq ".";
next if $dirname2 eq "..";
opendir ( DIR2, $dirname2 ) || die "Error in opening dir $dirname2\n";
while( ($file = readdir(DIR2)) )
{
next if $file eq ".";
next if $file eq "..";
print( "file:$file\n" );
}
closedir(DIR2);
}
closedir(DIR);
It always fails with the message "Error in opening dir alex". 'alex' happens to be the first directory in the data directory. My question is - where is the problem? Is this even the correct way how to achieve what i'm trying to do? I'm also worried that this my fail if there is a file also in the data folder, since i cannot open it with opendir, or can I?
PS: sorry for that horrible Perl code - i'm still trying to learn this language.
Thanks,
Peter
You can try File::Path - Create or remove directory trees
As i am running your program, i think you have to specify your full path while opening a directory ie.,
opendir ( DIR2, $dirname.\\.$dirname2 ) || die "Error in opening dir $dirname2\n"; #running code on windows
It will work, try it.
you can use File::Find to do find files nested directories
Are you sure that inside folder exist only folders? Add additional check:
next if !(-d $dirname2);
Here is a slightly cleaned up version of what was posted in the question.
use strict;
use warnings;
use autodie;
use File::Spec::Functions qw'catdir catfile';
my $dirname = "data";
{
opendir my $dir_h, $dirname;
while( my $dirname2 = readdir($dir_h) ){
next if $dirname2 eq ".";
next if $dirname2 eq "..";
$dirname2 = catdir( $dirname, $dirname2 );
next unless -d $dirname2;
opendir my $dir_h2, $dirname2;
while( my $file = readdir($dir_h2) )
{
next if $file eq ".";
next if $file eq "..";
$file = catfile($dirname2,$file);
if( -f $file ){
print( "file:$file\n" );
}
}
# $dir_h2 automatically closes here
}
# $dir_h automatically closes here
}
If you are going to run it on Perl versions earlier than 5.12.0 you should wrap the while loop's conditional with defined().
while( my $dirname2 = readdir($dir_h) ){
while( defined( my $dirname2 = readdir($dir_h) ) ){
I am trying to prefix a string (reference_) to the names of all the *.bmp files in all the directories as well sub-directories. The first time we run the silk script, it will create directories as well subdirectories, and under each subdirectory it will store each mobile application's sceenshot with .bmp extension.
When I run the automated silkscript for second time it will again create the *.bmp files in all the subdirectories. Before running the script for second time I want to prefix all the *.bmp with a string reference_.
For example first_screen.bmp to reference_first_screen.bmp,
I have the directory structure as below:
C:\Image_Repository\BG_Images\second
...
C:\Image_Repository\BG_Images\sixth
having first_screen.bmp and first_screen.bmp files etc...
Could any one help me out?
How can I prefix all the image file names with reference_ string?
When I run the script for second time, the Perl script in silk will take both the images from the sub-directory and compare them both pixel by pixel. I am trying with code below.
Could you please guide me how can I proceed to complete this task.
#!/usr/bin/perl -w
&one;
&two;
sub one {
use Cwd;
my $dir ="C:\\Image_Repository";
#print "$dir\n";
opendir(DIR,"+<$dir") or "die $!\n";
my #dir = readdir DIR;
#$lines=#dir;
delete $dir[-1];
print "$lines\n";
foreach my $item (#dir)
{
print "$item\n";
}
closedir DIR;
}
sub two {
use Cwd;
my $dir1 ="C:\\Image_Repository\\BG_Images";
#print "$dir1\n";
opendir(D,"+<$dir1") or "die $!\n";
my #dire = readdir D;
#$lines=#dire;
delete $dire[-1];
#print "$lines\n";
foreach my $item (#dire)
{
#print "$item\n";
$dir2="C:\\Image_Repository\\BG_Images\\$item";
print $dir2;
opendir(D1,"+<$dir2") or die " $!\n";
my #files=readdir D1;
#print "#files\n";
foreach $one (#files)
{
$one="reference_".$one;
print "$one\n";
#rename $one,Reference_.$one;
}
}
closedir DIR;
}
I tried open call with '+<' mode but I am getting compilation error for the read and write mode.
When I am running this code, it shows the files in BG_images folder with prefixed string but actually it's not updating the files in the sub-directories.
You don't open a directory for writing. Just use opendir without the mode parts of the string:
opendir my($dir), $dirname or die "Could not open $dirname: $!";
However, you don't need that. You can use File::Find to make the list of files you need.
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use File::Find;
use File::Find::Closures qw(find_regular_files);
use File::Spec::Functions qw(catfile);
my( $wanted, $reporter ) = find_regular_files;
find( $wanted, $ARGV[0] );
my $prefix = 'recursive_';
foreach my $file ( $reporter->() )
{
my $basename = basename( $file );
if( index( $basename, $prefix ) == 0 )
{
print STDERR "$file already has '$prefix'! Skipping.\n";
next;
}
my $new_path = catfile(
dirname( $file ),
"recursive_$basename"
);
unless( rename $file, $new_path )
{
print STDERR "Could not rename $file: $!\n";
next;
}
print $file, "\n";
}
You should probably check out the File::Find module for this - it will make recursing up and down the directory tree simpler.
You should probably be scanning the file names and modifying those that don't start with reference_ so that they do. That may require splitting the file name up into a directory name and a file name and then prefixing the file name part with reference_. That's done with the File::Basename module.
At some point, you need to decide what happens when you run the script the third time. Do the files that already start with reference_ get overwritten, or do the unprefixed files get overwritten, or what?
The reason the files are not being renamed is that the rename operation is commented out. Remember to add use strict; at the top of your script (as well as the -w option which you did use).
If you get a list of files in an array #files (and the names are base names, so you don't have to fiddle with File::Basename), then the loop might look like:
foreach my $one (#files)
{
my $new = "reference_$one";
print "$one --> $new\n";
rename $one, $new or die "failed to rename $one to $new ($!)";
}
With the aid of find utility from coreutils for Windows:
$ find -iname "*.bmp" | perl -wlne"chomp; ($prefix, $basename) = split(m~\/([^/]+)$~, $_); rename($_, join(q(/), ($prefix, q(reference_).$basename))) or warn qq(failed to rename '$_': $!)"