How to check in Perl whether there is any sub folder exist in a folder? - perl

Is there a way to check whether there is any subfolder exist inside a folder. I would like to do this in Perl?

Glob through the contents of the directory, and check whether it is a directory with -d.
sub has_subfolder {
my $directory = shift;
for ( <$directory/*>, <$directory/.*> ) {
next if m#/\.\.?$#; # skip . and ..
return 1 if -d;
}
return 0;
}

if (grep -d, glob("$folder/*")) {
print "$folder has subfolder(s)\n";
}
If you want to deal with directories matching .*, you could do:
if (grep -d && !/\.\.?$/, glob("$folder/.* $folder/*")) {
print "$folder has subfolder(s)\n";
}

You can use the'File::Find' module for this purpose. File::Find processes and scans a directory recursively. Here is the sample code:
use File::Find;
my $DirName = 'dirname' ;
sub has_subdir
{
#The path of the file/dir being visited.
my $subdir = $File::Find::name;
#Ignore if this is a file.
return unless -d $subdir;
#Ignore if $subdir is $Dirname itself.
return if ( $subdir eq $DirName);
# if we have reached here, this is a subdirector.
print "Sub directory found - $subdir\n";
}
#For each file and sub directory in $Dirname, 'find' calls
#the 'has_subdir' subroutine recursively.
find (\&has_subdir, $DirName);

In order to check if a subfolder exists in a directory (without knowing any names):
my $dir_name = "some_directory";
opendir my $dir, $dir_name
or die "Could not open directory $dir_name: $!";
my $has_subfolder = grep { -d && !/(^|\/)\.\.?$/ } map { ("$dir_name"||'.')."/$_" } readdir $dir;
In other words, it checks for one or more files in the directory which are themselves directories.
If you want a specific subfolder, just use Geo's answer.
Edit: This is getting silly now, but here's a truly general-purpose answer. :-P Someone else is getting the check mark anyway.

sub hasSubDir {
my $dir_name = shift;
opendir my $dir, $dir_name
or die "Could not open directory $dir_name: $!";
my #files = readdir($dir);
closedir($dir);
for my $file (#files) {
if($file !~ /\.\.?$/) {
return 1 if -d $dir/$file;
}
}
return 0;
}

OK, I'm just gonna have to submit my own answer
sub has_subfolder {
my $dir = shift;
my $found = 0;
opendir my $dh, $dir or die "Could not open directory $dir: $!";
while (my $_ = readdir($dh)) {
next if (/^\.\.?$/); # skip '.' and '..'
my $path = $dir . '/' . $_; # readdir doesn't return the whole path
if (-d $path) { # found a dir? record it, and leave the loop!
$found = 1;
last;
}
closedir($dh); # make sure we cleanup after!
return $found;
}
Compared to other answers:
finds hidden directories
completes as soon as it finds a match
doesn't traverse the tree twice (once for normal files, and again for hidden files)
EDIT - I see the requirements just changed (sigh). Fortunately the code above is trivially modified:
sub get_folders {
my $dir = shift;
my #found;
opendir my $dh, $dir or die "Could not open directory $dir: $!";
while (my $_ = readdir($dh)) {
next if (/^\.\.?$/); # skip '.' and '..'
my $path = $dir . '/' . $_; # readdir doesn't return the whole path
push(#found, $_) if (-d $path) # found a dir? record it
}
closedir($dh); # make sure we cleanup after!
return #found;
}

if(-e "some_folder/some_subfolder") {
print "folder exists";
}
else {
print "folder does not exist";
}

Related

Directory Handle in Perl Not Working Properly

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

Perl copying files from one directory to another

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.

perl iterate through directories

I'm trying to get the name of all directories in the specified path
I tried the following but that gives me every level down not just at the path i specified
find(\&dir_names, "C:\\mydata\\");
sub dir_names {
print "$File::Find::dir\n" if(-f $File::Find::dir,'/');
}
my #dirs = grep { -d } glob 'C:\mydata\*';
Use opendir instead
opendir DIR, $dirname or die "Couldn't open dir '$dirname': $!";
my #files = readdir(DIR);
closedir DIR;
#next processing...
EDIT:
"This will give all the files, not just the directories. You'd still have to grep."
Yes, and in that case you can just use file test operator to see whether it's a directory or not.
In Windows:
$dirname="C:\\";
opendir(DIR, $dirname);
#files = readdir(DIR);
closedir DIR;
foreach $key (#files)
{
if(-d "$dirname\\$key")
{
print "$key\n";
}
}
See chapter 2 Filesystems from Automating System Administration with Perl. That provides us with this:
sub ScanDirectory{
my ($workdir) = shift;
chdir($workdir) or die "Unable to enter dir $workdir:$!\n";
opendir(DIR, ".") or die "Unable to open $workdir:$!\n";
my #names = readdir(DIR) or die "Unable to read $workdir:$!\n";
closedir(DIR);
foreach my $name (#names){
next if ($name eq ".");
next if ($name eq "..");
if (-d $name){ # is this a directory?
#Whatever you want to do goes here.
}
}
}
glob or readdir would probably be my choice too. Another way to do it is to use the windows dir command to do the job:
my #dirs = qx(dir /AD /B);
chomp #dirs;

Detect empty directory with Perl

What is an easy way to test if a folder is empty in perl? -s, and -z are not working.
Example:
#Ensure Apps directory exists on the test PC.
if ( ! -s $gAppsDir )
{
die "\n$gAppsDir is not accessible or does not exist.\n";
}
#Ensure Apps directory exists on the test PC.
if ( ! -z $gAppsDir )
{
die "\n$gAppsDir is not accessible or does not exist.\n";
}
These above, do not work properly to tell me that the folder is empty. Thanks!
Thanks all! I ended up using:
sub is_folder_empty { my $dirname = shift; opendir(my $dh, $dirname) or die "Not a directory";
return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0; }
A little verbose for clarity, but:
sub is_folder_empty {
my $dirname = shift;
opendir(my $dh, $dirname) or die "Not a directory";
return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0;
}
Then you can do:
if (is_folder_empty($your_dir)) {
....
}
Using grep { ! /^[.][.]?\z/ } readdir $dir_h can be problematic for performance in case the check is done many times and some directories may have many files.
It would be better to short-circuit the moment a directory entry other than . or .. is found.
On Windows XP with ActiveState perl 5.10.1, the following sub seems to be twice as fast as the grep approach on my $HOME with 100 entries:
sub is_dir_empty {
my ($dir) = #_;
opendir my $h, $dir
or die "Cannot open directory: '$dir': $!";
while ( defined (my $entry = readdir $h) ) {
return unless $entry =~ /^[.][.]?\z/;
}
return 1;
}
Or without any grepping or regular expressions - which rules out any chance of weird file names accidentally getting though. Plus slightly faster is my testing.
#!/usr/bin/perl
use strict;
use warnings;
sub is_dir_empty {
return -1 if not -e $_[0]; # does not exist
return -2 if not -d $_[0]; # in not a directory
opendir my $dir, $_[0] or # likely a permissions issue
die "Can't opendir '".$_[0]."', because: $!\n";
readdir $dir;
readdir $dir;
return 0 if( readdir $dir ); # 3rd times a charm
return 1;
}
my #folders = qw( ./ ./empty ./hasonefile ./hastwofiles ./doesnotexist ./afile );
for my $folder ( #folders ) {
print "Folder '$folder' ";
my $rc = is_dir_empty( $folder );
if( $rc == -1 ) {
print "does not exist\n";
} elsif( $rc == -2 ) {
print "is not a directory\n";
} elsif( !$rc ) {
print "is not empty\n";
} else {
print "is empty\n";
}
}
Pretty simple. If you get three valid responses from a call to readdir, then you know there must be a file in there. Regardless of what name the file may have - or the order in which the files are being processed. Would have preferred something called 'is_dir_used' as I personally don't like the double-negative function name and return value.
There is also File::List from cpan. It's overkill here, but can be handy for slightly more complex requests like test if a directory is empty with the meaning it contains only empty directories (ie: not files).
Here is a more consise algorithm using Perl v5.12 (from circa 2010).
At most, three reads of the directory are made.
It does NOT read the whole directory.
It handles non-Unix filesystems that do not have '..'; See 'find' '-noleaf'
Desc: return true if empty, false if not empty; die if opendir() error
sub is_dir_empty {
use 5.012; # so readdir assigns to $_ in a lone while test
local($_); # prevent side effects
my $dir = shift // die "arg missing";
opendir my $dh, $dir or die "opendir(..,$dir): $!";
while ( readdir $dh ) {
return 0 if ! /^ [.][.]? $/x;
}
return 1;
} # is_dir_empty()
Credit to DevShed
if (scalar <directory/*>) {print qq|File Exists\n|}
Edit
To include hidden files:
#arr = <directory/* directory/.*>;
#arr = grep {!/^directory/[.]{1,2}$/} #arr;
if (#arr) { print qq|File or Directory Exists\n| }
Please read the comments as there have been good points made. Despite the negative points this answer has received, it is still correct.
opendir(DIR,"DIR PATH") or die "Unable to open directory \"DIR PATH\" \n";
my #drList = readdir(DIR);
close(DIR);
if( grep(/\w/,#drList) ){ print "Not Empty\n" }
else { print "Empty\n" }
sub is_folder_empty {
my $dirname = shift;
my #files = File::Find::Rule->file()->name('*')->maxdepth(1)->in("$dirname");
return $#files < 0;
}

How do I read in the contents of a directory in Perl?

How do I get Perl to read the contents of a given directory into an array?
Backticks can do it, but is there some method using 'scandir' or a similar term?
opendir(D, "/path/to/directory") || die "Can't open directory: $!\n";
while (my $f = readdir(D)) {
print "\$f = $f\n";
}
closedir(D);
EDIT: Oh, sorry, missed the "into an array" part:
my $d = shift;
opendir(D, "$d") || die "Can't open directory $d: $!\n";
my #list = readdir(D);
closedir(D);
foreach my $f (#list) {
print "\$f = $f\n";
}
EDIT2: Most of the other answers are valid, but I wanted to comment on this answer specifically, in which this solution is offered:
opendir(DIR, $somedir) || die "Can't open directory $somedir: $!";
#dots = grep { (!/^\./) && -f "$somedir/$_" } readdir(DIR);
closedir DIR;
First, to document what it's doing since the poster didn't: it's passing the returned list from readdir() through a grep() that only returns those values that are files (as opposed to directories, devices, named pipes, etc.) and that do not begin with a dot (which makes the list name #dots misleading, but that's due to the change he made when copying it over from the readdir() documentation). Since it limits the contents of the directory it returns, I don't think it's technically a correct answer to this question, but it illustrates a common idiom used to filter filenames in Perl, and I thought it would be valuable to document. Another example seen a lot is:
#list = grep !/^\.\.?$/, readdir(D);
This snippet reads all contents from the directory handle D except '.' and '..', since those are very rarely desired to be used in the listing.
A quick and dirty solution is to use glob
#files = glob ('/path/to/dir/*');
This will do it, in one line (note the '*' wildcard at the end)
#files = </path/to/directory/*>;
# To demonstrate:
print join(", ", #files);
IO::Dir is nice and provides a tied hash interface as well.
From the perldoc:
use IO::Dir;
$d = IO::Dir->new(".");
if (defined $d) {
while (defined($_ = $d->read)) { something($_); }
$d->rewind;
while (defined($_ = $d->read)) { something_else($_); }
undef $d;
}
tie %dir, 'IO::Dir', ".";
foreach (keys %dir) {
print $_, " " , $dir{$_}->size,"\n";
}
So you could do something like:
tie %dir, 'IO::Dir', $directory_name;
my #dirs = keys %dir;
You could use DirHandle:
use DirHandle;
$d = new DirHandle ".";
if (defined $d)
{
while (defined($_ = $d->read)) { something($_); }
$d->rewind;
while (defined($_ = $d->read)) { something_else($_); }
undef $d;
}
DirHandle provides an alternative, cleaner interface to the opendir(), closedir(), readdir(), and rewinddir() functions.
Similar to the above, but I think the best version is (slightly modified) from "perldoc -f readdir":
opendir(DIR, $somedir) || die "can't opendir $somedir: $!";
#dots = grep { (!/^\./) && -f "$somedir/$_" } readdir(DIR);
closedir DIR;
You can also use the children method from the popular Path::Tiny module:
use Path::Tiny;
my #files = path("/path/to/dir")->children;
This creates an array of Path::Tiny objects, which are often more useful than just filenames if you want to do things to the files, but if you want just the names:
my #files = map { $_->stringify } path("/path/to/dir")->children;
Here's an example of recursing through a directory structure and copying files from a backup script I wrote.
sub copy_directory {
my ($source, $dest) = #_;
my $start = time;
# get the contents of the directory.
opendir(D, $source);
my #f = readdir(D);
closedir(D);
# recurse through the directory structure and copy files.
foreach my $file (#f) {
# Setup the full path to the source and dest files.
my $filename = $source . "\\" . $file;
my $destfile = $dest . "\\" . $file;
# get the file info for the 2 files.
my $sourceInfo = stat( $filename );
my $destInfo = stat( $destfile );
# make sure the destinatin directory exists.
mkdir( $dest, 0777 );
if ($file eq '.' || $file eq '..') {
} elsif (-d $filename) { # if it's a directory then recurse into it.
#print "entering $filename\n";
copy_directory($filename, $destfile);
} else {
# Only backup the file if it has been created/modified since the last backup
if( (not -e $destfile) || ($sourceInfo->mtime > $destInfo->mtime ) ) {
#print $filename . " -> " . $destfile . "\n";
copy( $filename, $destfile ) or print "Error copying $filename: $!\n";
}
}
}
print "$source copied in " . (time - $start) . " seconds.\n";
}
from: http://perlmeme.org/faqs/file_io/directory_listing.html
#!/usr/bin/perl
use strict;
use warnings;
my $directory = '/tmp';
opendir (DIR, $directory) or die $!;
while (my $file = readdir(DIR)) {
next if ($file =~ m/^\./);
print "$file\n";
}
The following example (based on a code sample from perldoc -f readdir) gets all the files (not directories) beginning with a period from the open directory. The filenames are found in the array #dots.
#!/usr/bin/perl
use strict;
use warnings;
my $dir = '/tmp';
opendir(DIR, $dir) or die $!;
my #dots
= grep {
/^\./ # Begins with a period
&& -f "$dir/$_" # and is a file
} readdir(DIR);
# Loop through the array printing out the filenames
foreach my $file (#dots) {
print "$file\n";
}
closedir(DIR);
exit 0;
closedir(DIR);
exit 0;