I'm writing test for function which gets list of all *.pm files in current directory.
Here is function:
sub get_inspected_modules_list {
my ( $dir ) = #_;
opendir(my $dh, $dir) or die $!;
my #files;
while (my $file = readdir($dh)) {
next unless (-f "$dir/$file"); # skip nested dirs
next unless ($file =~ m/\.pm$/); # push only *.pm
push #files, $file;
}
closedir($dh);
return \#files
}
I tried to use Test::MockFile::DirHandle for test, but it prints No such file or directory error:
subtest "get_inspected_modules_list" => sub {
my $handle = Test::MockFile::DirHandle->new(
"/fake/path",
[qw/Foo.pm Bar.pm Baz.pm test.txt 1.pl/]
);
warn Dumper get_inspected_modules_list( '/fake/path' ); # error
};
How to mock opendir/readdir calls ?
Right usage is
my $mocked_dir = Test::MockFile->dir("/fake/path", [ 'Foo.pm', 'bar.pl' ] );
opendir(my $dh, "/fake/path") or die $!;
while (my $file = readdir($dh)) {
print "$file "; # will print '. .. Foo.pm bar.pl'
}
undef $mocked_dir;
So, instead of Test::MockFile::DirHandle you should use Test::MockFile->dir
Related
I am trying to read files inside a folder in Perl using Directory Handle. The script is able to show the file name but it is throwing two errors: readdir() attempted on invalid dirhandle DIR and closedir() attempted on invalid dirhandle DIR.
I am calling a subroutine and passing two values:
if($fileEnding eq "directory")
{
print "$fileName is a directory\n";
FolderInvestigator1($a, $fileName);
}
$a holds the directory name and its path which is being passed via command-line argument. I am passing the control to a subroutine.
Below is my code:-
sub FolderInvestigator1
{
my $prevPath = shift;
my $receivedFolder = shift;
my $realPath = "$prevPath/$receivedFolder";
my $path = File::Spec->rel2abs($realPath);
print "$path\n";
print "$receivedFolder Folder Received\n";
opendir(DIR, $path) or die "You've Passed Invalid Directory as Arguments\n";
while(my $fileName = readdir DIR)
{
next if $fileName =~ /^\./;
print "The Vacant Folder has $fileName file\n";
}
closedir(DIR);
}
Here is my complete code:-
FirstResponder();
sub FirstResponder
{
if (#ARGV == 0)
{
print "No Arguments Passed\n";
}
else
{
foreach my $a(#ARGV)
{
print "Investigating $a directory below:-\n";
opendir(DIR, $a) or die "You've Passed Invalid Directory as Arguments\n";
while(my $fileName = readdir DIR)
{
next if $fileName =~ /^\./;
$ending = `file --mime-type $a/$fileName`;
#print $ending;
$fileEnding = `basename -s $ending`;
#print $fileEnding;
chomp($fileEnding);
#print $fileName,"\n";
if($fileEnding eq "directory")
{
print "$fileName is a directory\n";
FolderInvestigator1($a, $fileName);
}
else
{
CureExtensions($a, $fileName);
}
}
closedir(DIR);
my #files = glob("$a/*");
my $size = #files;
if($size == 0)
{
print "The $a is an empty directory\n";
}
}
}#Foreach Ends Here..
}
Please see the screenshot for more information on what's going on!
I am not able to realize why Directory Handle is throwing error even though I made the path correct. Some guidance will be highly appreciated.
The problem with your code is that you have a nested use of the bareword (global) dir handle DIR, and hence the inner loop closes the handle before the outer loop is finished:
opendir(DIR, $arg) or die "...";
while(my $fileName = readdir DIR) {
# ... more code here
opendir(DIR, $path) or die "...";
while(my $file = readdir DIR) {
# ... more code here
}
closedir DIR;
}
closedir DIR;
Here is an example of how you could write the first loop using a lexical dir handle $DIR instead of using a legacy global bareword handle DIR:
use feature qw(say);
use strict;
use warnings;
use File::Spec;
FirstResponder();
sub FirstResponder {
foreach my $arg (#ARGV) {
print "Investigating $arg directory below:-\n";
opendir(my $DIR, $arg) or die "You've Passed Invalid Directory as Arguments\n";
my $size = 0;
while(my $fileName = readdir $DIR) {
next if $fileName =~ /^\./;
my $path = File::Spec->catfile( $arg, $fileName );
if( -d $path) {
print "$fileName is a directory\n";
say "FolderInvestigator1($arg, $fileName)"
}
else {
say "CureExtensions($arg, $fileName)";
}
$size++;
}
closedir $DIR;
if($size == 0) {
print "The $arg is an empty directory\n";
}
}
}
The use of bareword filehandle names is old style and deprecated, according to perldoc open:
An older style is to use a bareword as the filehandle, as
open(FH, "<", "input.txt")
or die "Can't open < input.txt: $!";
Then you can use FH as the filehandle, in close FH and and so on. Note that it's a global
variable, so this form is not recommended in new code.
See also:
Why does Perl open() documentation use two different FILEHANDLE style?
Don't Open Files in the old way
I'm trying to copy files from multiple directories with the code bellow. It prints out the correct path and files but fails to copy them. Please suggest how to fix this issue? Thanks
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy;
my $target_dir = "";
my #dirs = grep { -d } glob '/data/results/*';
for my $source_dir ( #dirs ) {
opendir(my $DIR, $source_dir) || die "can't opendir $source_dir: $!";
my #files = readdir($DIR);
print "the directory is $source_dir\n";
my $run_folder = (split '/', $source_dir)[3];
print "the folder is $run_folder\n";
$target_dir = "/data/backup/$run_folder";
print $target_dir;
foreach my $t (#files)
{
if(-f "$source_dir/$t" ) {
#Check with -f only for files (no directories)
print "$source_dir/$t";
print "$target_dir/$t";
copy "$source_dir/$t", "$target_dir/$t";
}
}
closedir($DIR);
}
There are a few things I would recommend you to do:
Close your file handles as soon as possible if you are not using it anymore:
opendir(my $DIR, $source_dir) || die "can't opendir $source_dir: $!";
my #files = readdir($DIR);
close ($DIR);
As you are trying to backup some files and directories maybe the target destination will not have the directory so:
$target_dir = "/data/backup/$run_folder";
print $target_dir;
if ( ! -d $target_dir )
{
#creates the dir
}
And the last one:
foreach my $t (#files)
{
chomp $t; # it removes any new line
if(-f "$source_dir/$t" ) {
#Check with -f only for files (no directories)
print "$source_dir/$t";
print "$target_dir/$t";
if ( ! copy "$source_dir/$t", "$target_dir/$t" )
{
print "Some error: $!";
}
}
}
Always TIMTOWTD, you could use File::Find which has a simple tutorial here.
Currently in a perl script I am using the glob function to get a list of files with specific extensions.
my #filearray = glob("$DIR/*.abc $DIR/*.llc");
Is there any alternative to glob, to get the list of files with specific extension from a folder? If so please provide me some example? Thank you
Yes, there are much more complicated ways, like opendir, readdir and a regex filter. They will also give you the hidden files (or dotfiles):
opendir DIR, $DIR or die $!;
my #filearray = grep { /\.(abc|llc)$/ } readdir DIR;
closedir DIR;
#Using:
opendir(DIR, $dir) || die "$!";
my #files = grep(/\.[abc|lic]*$/, readdir(DIR));
closedir(DIR);
#Reference: CPAN
use Path::Class; # Exports dir() by default
my $dir = dir('foo', 'bar'); # Path::Class::Dir object
my $dir = Path::Class::Dir->new('foo', 'bar'); # Same thing
my $file = $dir->file('file.txt'); # A file in this directory
my $handle = $dir->open;
while (my $file = $handle->read)
{
$file = $dir->file($file); # Turn into Path::Class::File object
...
}
#Reference: Refered: http://accad.osu.edu/~mlewis/Class/Perl/perl.html#cd
# search for a file in all subdirectories
#!/usr/local/bin/perl
if ($#ARGV != 0) {
print "usage: findfile filename\n";
exit;
}
$filename = $ARGV[0];
# look in current directory
$dir = getcwd();
chop($dir);
&searchDirectory($dir);
sub searchDirectory
{
local($dir);
local(#lines);
local($line);
local($file);
local($subdir);
$dir = $_[0];
# check for permission
if(-x $dir)
{
# search this directory
#lines = `cd $dir; ls -l | grep $filename`;
foreach $line (#lines)
{
$line =~ /\s+(\S+)$/;
$file = $1;
print "Found $file in $dir\n";
}
# search any sub directories
#lines = `cd $dir; ls -l`;
foreach $line (#lines)
{
if($line =~ /^d/)
{
$line =~ /\s+(\S+)$/;
$subdir = $dir."/".$1;
&searchDirectory($subdir);
}
}
}
}
Please try another one:
use Cwd;
use File::Find;
my $dir = getcwd();
my #abclicfiles;
find(\&wanted, $dir);
sub wanted
{
push(#abclicfiles, $File::Find::name) if($File::Find::name=~m/\.(abc|lic)$/i);
}
print join "\n", #abclicfiles;
This the directory which is getting from user:
print "Please enter the directory: ";
my $dir = <STDIN>;
chomp($dir);
opendir(DIR, $dir) || die "Couldn't able to read dir: $!";
my #files = grep(/\.(txt|lic)$/, readdir(DIR));
closedir(DIR);
print join "\n", #files;
Apologies if this is a bit long winded, bu i really appreciate an answer here as i am having difficulty getting this to work.
Building on from this question here, i have this script that works on a csv file(orig.csv) and provides a csv file that i want(format.csv). What I want is to make this more generic and accept any number of '.csv' files and provide a 'output_csv' for each inputed file. Can anyone help?
#!/usr/bin/perl
use strict;
use warnings;
open my $orig_fh, '<', 'orig.csv' or die $!;
open my $format_fh, '>', 'format.csv' or die $!;
print $format_fh scalar <$orig_fh>; # Copy header line
my %data;
my #labels;
while (<$orig_fh>) {
chomp;
my #fields = split /,/, $_, -1;
my ($label, $max_val) = #fields[1,12];
if ( exists $data{$label} ) {
my $prev_max_val = $data{$label}[12] || 0;
$data{$label} = \#fields if $max_val and $max_val > $prev_max_val;
}
else {
$data{$label} = \#fields;
push #labels, $label;
}
}
for my $label (#labels) {
print $format_fh join(',', #{ $data{$label} }), "\n";
}
i was hoping to use this script from here but am having great difficulty putting the 2 together:
#!/usr/bin/perl
use strict;
use warnings;
#If you want to open a new output file for every input file
#Do it in your loop, not here.
#my $outfile = "KAC.pdb";
#open( my $fh, '>>', $outfile );
opendir( DIR, "/data/tmp" ) or die "$!";
my #files = readdir(DIR);
closedir DIR;
foreach my $file (#files) {
open( FH, "/data/tmp/$file" ) or die "$!";
my $outfile = "output_$file"; #Add a prefix (anything, doesn't have to say 'output')
open(my $fh, '>', $outfile);
while (<FH>) {
my ($line) = $_;
chomp($line);
if ( $line =~ m/KAC 50/ ) {
print $fh $_;
}
}
close($fh);
}
the script reads all the files in the directory and finds the line with this string 'KAC 50' and then appends that line to an output_$file for that inputfile. so there will be 1 output_$file for every inputfile that is read
issues with this script that I have noted and was looking to fix:
- it reads the '.' and '..' files in the directory and produces a
'output_.' and 'output_..' file
- it will also do the same with this script file.
I was also trying to make it dynamic by getting this script to work in any directory it is run in by adding this code:
use Cwd qw();
my $path = Cwd::cwd();
print "$path\n";
and
opendir( DIR, $path ) or die "$!"; # open the current directory
open( FH, "$path/$file" ) or die "$!"; #open the file
**EDIT::I have tried combining the versions but am getting errors.Advise greatly appreciated*
UserName#wabcl13 ~/Perl
$ perl formatfile_QforStackOverflow.pl
Parentheses missing around "my" list at formatfile_QforStackOverflow.pl line 13.
source dir -> /home/UserName/Perl
Can't use string ("/home/UserName/Perl/format_or"...) as a symbol ref while "strict refs" in use at formatfile_QforStackOverflow.pl line 28.
combined code::
use strict;
use warnings;
use autodie; # this is used for the multiple files part...
#START::Getting current working directory
use Cwd qw();
my $source_dir = Cwd::cwd();
#END::Getting current working directory
print "source dir -> $source_dir\n";
my $output_prefix = 'format_';
opendir my $dh, $source_dir; #Changing this to work on current directory; changing back
for my $file (readdir($dh)) {
next if $file !~ /\.csv$/;
next if $file =~ /^\Q$output_prefix\E/;
my $orig_file = "$source_dir/$file";
my $format_file = "$source_dir/$output_prefix$file";
# .... old processing code here ...
## Start:: This part works on one file edited for this script ##
#open my $orig_fh, '<', 'orig.csv' or die $!; #line 14 and 15 above already do this!!
#open my $format_fh, '>', 'format.csv' or die $!;
#print $format_fh scalar <$orig_fh>; # Copy header line #orig needs changeing
print $format_file scalar <$orig_file>; # Copy header line
my %data;
my #labels;
#while (<$orig_fh>) { #orig needs changing
while (<$orig_file>) {
chomp;
my #fields = split /,/, $_, -1;
my ($label, $max_val) = #fields[1,12];
if ( exists $data{$label} ) {
my $prev_max_val = $data{$label}[12] || 0;
$data{$label} = \#fields if $max_val and $max_val > $prev_max_val;
}
else {
$data{$label} = \#fields;
push #labels, $label;
}
}
for my $label (#labels) {
#print $format_fh join(',', #{ $data{$label} }), "\n"; #orig needs changing
print $format_file join(',', #{ $data{$label} }), "\n";
}
## END:: This part works on one file edited for this script ##
}
How do you plan on inputting the list of files to process and their preferred output destination? Maybe just have a fixed directory that you want to process all the cvs files, and prefix the result.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
my $source_dir = '/some/dir/with/cvs/files';
my $output_prefix = 'format_';
opendir my $dh, $source_dir;
for my $file (readdir($dh)) {
next if $file !~ /\.csv$/;
next if $file =~ /^\Q$output_prefix\E/;
my $orig_file = "$source_dir/$file";
my $format_file = "$source_dir/$output_prefix$file";
.... old processing code here ...
}
Alternatively, you could just have an output directory instead of prefixing the files. Either way, this should get you on your way.
in Perl i need to read file from a parent directory to it's last file it any sub directory is there i need to read those files too!so I've tried something like this with the help of recursive function but it gives infinite loop so can anybody help me!
code;
sub fileProcess{
(my $file_name)=#_;
print "$file_name it is file\n";
}
sub main{
(my $dir)=#_;
chdir $dir;
my $tmp=`pwd`;
my #tmp =<*>;
chomp(#tmp);
foreach my $item(#tmp){
chomp($item);
if(-d $item){
dirProcess("$tmp/$item");
}else{
fileProcess($item);
}
}
}
sub dirProcess{
(my $file_name)=#_;
print ">>the corresponding dir is $file_name<<";
main($file_name);
}
my $home="../../Desktop";
chdir $home;
my $path=`pwd`;
main($home);
Here's a sub that will search recursively :
sub find_files {
my ($dir) = #_;
my (#files, #dirs) = ();
my (#allfiles, #alldirs) = ();
opendir my $dir_handle, $dir or die $!;
while( defined( my $ent = readdir $dir_handle ) ) {
next if $ent =~ /^\.\.?$/;
if( -f "$dir/$ent" ) {
push #files, "$dir/$ent";
} elsif( -d "$dir/$ent" ) {
push #dirs, "$dir/$ent";
}
}
close $dir_handle;
push #allfiles, #{ process_files($_) } for #files;
push #alldirs, #{ find_files($_) } for #dirs;
return \#alldirs;
}
The main reason your code isn't working is that, when dirProcess it calls main again which does chdir to a different directory. That means the rest of the files in the #tmp array aren't found.
To fix it I have just added a chdir $dir after the call to dirProcess. In addition I have
Added use strict and use warnings. Yyou must always put these at the top of your program.
Removed all calls to pwd which were unnecessary. You know what you present working directory is because you've just set it!
Removed unnecessary chomp calls. The information from glob never has trailing newlines. The one string that did need chomping is $tmp but you didn't do it!
It's still not a very nice piece of code, but it works!
use strict;
use warnings;
sub fileProcess {
(my $file_name) = #_;
print "$file_name it is file\n";
}
sub main {
(my $dir) = #_;
chdir $dir;
my #tmp = <*>;
foreach my $item (#tmp) {
if (-d $item) {
dirProcess("$dir/$item");
chdir $dir;
}
else {
fileProcess($item);
}
}
}
sub dirProcess {
(my $file_name) = #_;
print ">>the corresponding dir is $file_name<<\n";
main($file_name);
}
my $home = "../../Desktop";
main($home);