From user's input, I should able to search its sub directories until the fixed directory which named 'list'. The question is how to store the path into hash so that I could retrieve the data and display it afterwards.
my directory tree:
->blue -->Aug21 --->projA ---->list ----->name
/tmp/general/place/brand->red -->Jan03
->yellow -->June22 --->projB ---->list
directory.pl:
use strict;
use warnings;
print "Searching Directory...\n";
&search_dir('/tmp/general/place/brand'); #could be 'tmp/general/place/brand/blue/Aug21'
my ($input,$tt,$str,$fn,#pp,#cap);
sub search_dir{
$input=shift;
opendir DH,$input or die"$!";
while($_=readdir(DH)){
next if $_ eq "." or $_ eq "..";
if ($_ eq "list"){
$fn = $input.'/'.$_;
push #pp, $fn;
return;
}
else{
$fn = $input.'/'.$_;
}
if(-d $fn){
push #cap,$fn;
}
}
if(scalar #cap == 0){
return;
}
foreach (#cap){
&search_dir($_) ;
}
}
if (#pp){
print "Located directory...\n";
foreach $tt (#pp){
$str='/tmp/general/place/brand';
$tt=~ s/$str//g;
print $tt,"\n";
#Hash? $file{$color}{$date}{$quantity}{$list}= split (/\//,$tt);
}
}
else {
print "Could not locate directory\n";
}
Expected Output:
Searching Directory...
Located Directory...
/blue/Aug21/projA/list
/yellow/June22/projB/list
Info :1
Color :blue
Date :Aug21
Project :projA
Info :2
Color :yellow
Date :June22
Project:projB
Under linux it maybe easier to use find. Quick and dirty but it will do the job.
my #dirs = `/usr/bin/find -name "/tmp/general/place/brand/" -type d`;
chomp(#dirs);
my $data = {};
foreach my $dir (#dirs){
my #path = split(/\//,$dir);
#you have found a list in the right depth
if (scalar(#path) >= 7 && $path[7] eq 'list'){
$dir =~ s!/tmp/general/place/brand!!is;
print "Found $dir\n";
print "Color :".$path[4];
...
}
}
Related
How to search a file named ".cfg" in a directory and all it's parent directories
I am fetching the name as below code but i would like to know if there is any better way to do it.
Also i would like to know the recursive way to do the same.
sub get_p4_config_updir($ $)
{
my ($client_root, $cfg_file) = #_;
# Dir from where search starts - it's a client root here
my $cur_dir = $client_root;
printf("**** cur_dir: $cur_dir ****\n");
my $slashes = $cur_dir =~ y/\///;
printf("**** no of back slashes: $slashes ****\n");
while($slashes > 2) {
my ($parent_dir, $b) = $cur_dir =~ /(.*)\/(.*)/;
printf("**** parent_dir: $parent_dir, b: $b ****\n");
$slashes--;
if (-e "$cur_dir/$cfg_file") {
printf("**** File exists in dir: $cur_dir ****\n");
return $cur_dir;
}
$cur_dir = $parent_dir;
}
return "";
}
my $cfg = '.cfg';
my $dir = '/user/home/wkspace/abc/def/MAIN';
my $path = get_p4_config_updir($dir, $cfg);
if ($path ne "") {
printf("**** File exists in dir: $path ****\n");
} else {
printf("**** File not found ****\n");
}
An example using Path::Tiny:
#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
use Path::Tiny;
# Returns a Path::Tiny object to the directory containing the file
# being looked for, or undef if not found.
sub get_p4_config_updir {
my ($client_root, $cfg_file) = #_;
my $dir = path($client_root)->realpath;
while (1) {
# say "Looking at $dir";
if ($dir->child($cfg_file)->exists) {
return $dir;
} elsif ($dir->is_rootdir) {
return undef;
} else {
$dir = $dir->parent;
}
}
}
my $cfg = '.cfg';
my $dir = '/user/home/wkspace/abc/def/MAIN';
say get_p4_config_updir($dir, $cfg) // "File not found";
Or a version that's similar to #rajashekar's idea of walking the directory tree by using chdir to get each directory's parent. This one uses File::chdir, which lets you localize changes to the current working directory (and restores the original when the function/scope exits), as well as providing a handy array view of the current directory and its parents that can be manipulated:
use File::chdir;
...
sub get_p4_config_updir {
my ($client_root, $cfg_file) = #_;
local $CWD = $client_root; # Magic happens here
while (1) {
# say "Looking at $CWD";
if (-e $cfg_file) {
return $CWD;
} elsif ($CWD eq "/") {
return undef;
} else {
pop #CWD; # CDs to the next parent directory
}
}
}
You can use core libraries to do this in a platform independent, readable way without having to use cwd and possibly causing action at a distance effects in the rest of your code:
#!/usr/bin/env perl
use strict;
use warnings;
use File::Spec::Functions qw(catfile rel2abs updir);
sub get_p4_config_updir
{
my ($dir, $file) = #_;
$dir = rel2abs($dir);
do {
my $path = catfile $dir => $file;
return $dir if -e $path;
return if $dir eq (my $new_dir = rel2abs(catfile $dir, updir));
$dir = $new_dir;
} while ('NOT_DONE');
return;
}
sub main {
my ($cfg, $dir) = #_;
my $path = get_p4_config_updir($dir, $cfg);
if (defined $path) {
printf("Found '%s' in '%s'\n", $cfg, $path);
}
else {
printf(
"Did not find '%s' in '%s' or any of its parent directories\n",
$cfg,
$dir,
);
}
}
main(#ARGV);
Output:
C:\Users\u\AppData\Local\Temp> perl p.pl linux.bin .
Found 'linux.bin' in 'C:\'
Why deal with pathnames, when you can walk the directory structure up with .. ?
if the file exists in the current directory return it.
else go up .. and the repeat the process.
use Cwd qw(cwd);
sub search_up {
my ($dir, $file) = #_;
chdir($dir);
while (1) {
if (-e $file) {
print "$file exists in $dir\n";
return $dir;
} elsif ($dir eq "/") {
return;
} else {
chdir("..");
$dir = cwd;
}
};
}
Please see if following code snippet complies with your requirements.
The script is looking for configuration file toward root of filesystem, found filenames are stored in an array #found.
use strict;
use warnings;
use feature 'say';
my $dir = '/user/home/wkspace/abc/def/MAIN';
my $ext = 'cfg';
my($cwd,#found);
for( split('/',$dir) ) {
$cwd .= "$_/";
push #found, glob( $cwd . "*\.$ext" );
}
if( #found ) {
say for #found;
} else {
say 'No file(s) was found';
}
exit 0;
Following code snippet is looking for configuration files away from root filesystem starting from $dir.
If any files found then they will be stored under array reference $found and then printed out on the terminal.
If no files get found then you will be informed with a message.
use strict;
use warnings;
use feature 'say';
my $dir = '/user/home/wkspace/abc/def/MAIN';
my $ext = 'cfg';
my $found = find($dir,$ext);
if( $found ) {
say for #$found;
} else {
say 'No file(s) was found';
}
exit 0;
sub find {
my $dir = shift;
my $ext = shift;
my $ret;
for( glob("$dir/*") ) {
push #$ret, $_ if /\.$ext\z/;
if( -d ) {
my $found = find($_,$ext);
push #$ret, #$found if $found;
}
}
return $ret;
}
I'm trying to clean up a directory that contains a lot of sub directories that actually belong in some of the sub directories, not the main directory.
For example, there is
Main directory
sub1
sub2
sub3
HHH
And HHH belongs in sub3. HHH has multiple text files inside of it (as well as some ..txt and ...txt files that I would like to ignore), and each of these text files has a string
some_pattern [sub3].
So, I attempted to write a script that looks into the file and then moves it into its corresponding directory
use File::Find;
use strict;
use warnings;
use File::Copy;
my $DATA = "D:/DATA/DATA_x/*";
my #dirs = grep { -d } glob $DATA;
foreach (#dirs) {
if ($_ =~ m/HHH/) {
print "$_\n";
my $file = "$_/*";
my #files = grep { -f } glob $file;
foreach (#files) {
print "file $_\n";
}
foreach (#files) {
print "\t$_\n";
my #folders = split('/', $_);
if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
print "$folders[4] ..txt\n";
}
foreach (#folders) {
print "$_\n";
}
open(FH, '<', $_);
my $value;
while (my $line = <FH>) {
if ($line =~ m/some_pattern/) {
($value) = $line =~ /\[(.+?)\]/;
($value) =~ s/\s*$//;
print "ident'$value'\n";
my $new_dir = "$folders[0]/$folders[1]/$folders[2]/$value/$folders[3]/$folders[4]";
print "making $folders[0]/$folders[1]/$folders[2]/$value/$folders[3]\n";
print "file is $folders[4]\n";
my $new_over_dir = "$folders[0]/$folders[1]/$value/$folders[2]/$folders[3]";
mkdir $new_over_dir or die "Can't make it $!";
print "going to swap\n '$_'\n for\n '$new_dir'\n";
move($_, $new_dir) or die "Can't $!";
}
}
}
}
}
It's saying
Can't make it No such file or directory at foo.pl line 57, <FH> line 82.
Why is it saying that it won't make a file that doesn't exist?
A while later: here is my final script:
use File::Find;
use strict;
use warnings;
use File::Copy;
my $DATA = "D:/DATA/DATA_x/*";
my #dirs = grep { -d } glob $DATA;
foreach (#dirs) {
if ($_ =~ m/HHH/) {
my $value;
my #folders;
print "$_\n";
my $file = "$_/*";
my #files = grep { -f } glob $file;
foreach (#files) {
print "file $_\n";
}
foreach (#files) {
print "\t$_\n";
#folders = split('/', $_);
if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
print "$folders[4] ..txt\n";
}
foreach (#folders) {
print "$_\n";
}
open(FH, '<', $_);
while (my $line = <FH>) {
if ($line =~ m/some_pattern/) {
($value) = $line =~ /\[(.+?)\]/;
($value) =~ s/\s*$//;
print "ident'$value'\n";
}
}
}
if($value){
print "value $value\n";
my $dir1 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$folders[5]";
my $dir2 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$value";
system("cp -r $dir1 $dir2");
}
}
}
}
This works. It looks like part of my problem from before was that I was trying to run this on a directory in my D: drive--when I moved it to the C: drive, it worked fine without any permissions errors or anything. I did try to implement something with Path::Tiny, but this script was so close to being functional (and it was functional in a Unix environment), that I decided to just complete it.
You really should read the Path::Tiny doccu. It probably contains everything you need.
Some starting points, without error handling and so on...
use strict;
use warnings;
use Path::Tiny;
my $start=path('D:/DATA/DATA_x');
my $iter = path($start)->iterator({recurse => 1});
while ( $curr = $iter->() ) {
#select here the needed files - add more conditions if need
next if $curr->is_dir; #skip directories
next if $curr =~ m/HHH.*\.{2,3}txt$/; #skip ...?txt
#say "$curr";
my $content = $curr->slurp;
if( $content =~ m/some_pattern/ ) {
#do something wih the file
say "doing something with $curr";
my $newfilename = path("insert what you need here"); #create the needed new path for the file ..
path($newfilename->dirname)->mkpath; #make directories
$curr->move($newfilename); #move the file
}
}
Are you sure of the directory path you are trying to create. The mkdir call might be failing if some of the intermediate directories doesn't exist. If your code is robust to ensure that
the variable $new_over_dir contains the directory path you have to create, you can use method make_path from perl module File::Path to create the new directory, instead of 'mkdir'.
From the documentation of make_path:
The make_path function creates the given directories if they don't
exists before, much like the Unix command mkdir -p.
Sorry for the bad title but this is the best I could do! :D
I have a script which creates a new project every time the specified function is called.
Each project must be stored in its own folder, with the name of the project. But, if you don't specify a name, the script will just name it "new projectX", where X is a progressive number.
With time the user could rename the folders or delete some, so every time the script runs, it checks for the smallest number available (not used by another folder) and creates the relevant folder.
Now I managed to make a program which I think works as wanted, but I would like to hear from you if it's OK or there's something wrong which I'm unable to spot, given my inexperience with the language.
while ( defined( $file = readdir $projects_dir ) )
{
# check for files whose name start with "new project"
if ( $file =~ m/^new project/i )
{
push( #files, $file );
}
}
# remove letters from filenames, only the number is left
foreach $file ( #files )
{
$file =~ s/[a-z]//ig;
}
#files = sort { $a <=> $b } #files;
# find the smallest number available
my $smallest_number = 0;
foreach $file ( #files )
{
if ( $smallest_number != $file )
{
last;
}
$smallest_number += 1;
}
print "Smallest number is $smallest_number";
Here's a basic approach for this sort of problem:
sub next_available_dir {
my $n = 1;
my $d;
$n ++ while -e ($d = "new project$n");
return $d;
}
my $project_dir = next_available_dir();
mkdir $project_dir;
If you're willing to use a naming pattern that plays nicely with Perl's string auto-increment feature, you can simplify the code further, eliminating the need for $n. For example, newproject000.
I think I would use something like:
use strict;
use warnings;
sub new_project_dir
{
my($base) = #_;
opendir(my $dh, $base) || die "Failed to open directory $base for reading";
my $file;
my #numbers;
while ($file = readdir $dh)
{
$numbers[$1] = 1 if ($file =~ m/^new project(\d+)$/)
}
closedir($dh) || die "Failed to close directory $base";
my $i;
my $max = $#numbers;
for ($i = 0; $i < $max; $i++)
{
next if (defined $numbers[$i]);
# Directory did not exist when we scanned the directory
# But maybe it was created since then!
my $dir = "new project$i";
next unless mkdir "$base/$dir";
return $dir;
}
# All numbers from 0..$max were in use...so try adding new numbers...
while ($i < $max + 100)
{
my $dir = "new project$i";
$i++;
next unless mkdir "$base/$dir";
return $dir;
}
# Still failed - give in...
die "Something is amiss - all directories 0..$i in use?";
}
Test code:
my $basedir = "base";
mkdir $basedir unless -d $basedir;
for (my $j = 0; $j < 10; $j++)
{
my $dir = new_project_dir($basedir);
print "Create: $dir\n";
if ($j % 3 == 2)
{
my $k = int($j / 2);
my $o = "new project$k";
rmdir "$basedir/$o";
print "Remove: $o\n";
}
}
Try this:
#!/usr/bin/env perl
use strict;
use warnings;
# get the current list of files
# see `perldoc -f glob` for details.
my #files = glob( 'some/dir/new\\ project*' );
# set to first name, in case there are none others
my $next_file = 'new project1';
# check for others
if( #files ){
# a Schwartian transform
#files = map { $_->[0] } # get original
sort { $a->[1] <=> $b->[1] } # sort by second field which are numbers
map { [ $_, do{ ( my $n = $_ ) =~ s/\D//g; $n } ] } # create an anonymous array with original value and the second field nothing but digits
#files;
# last file name is the biggest
$next_file = $files[-1];
# add one to it
$next_file =~ s/(.*)(\d+)$/$1.($2+1)/e;
}
print "next file: $next_file\n";
Nothing wrong per se, but that's an awful lot of code to achieve a single objective (get the minimum index of directories.
A core module, couple of subs and few Schwartzian transforms will make the code more flexible:
use strict;
use warnings;
use List::Util 'min';
sub num { $_[0] =~ s|\D+||g } # 'new project4' -> '4', 'new1_project4' -> '14' (!)
sub min_index {
my ( $dir, $filter ) = #_;
$filter = qr/./ unless defined $filter; # match all if no filter specified
opendir my $dirHandle, $dir or die $!;
my $lowest_index = min # get the smallest ...
map { num($_) } # ... numerical value ...
grep { -d } # ... from all directories ...
grep { /$filter/ } # ... that match the filter ...
readdir $dirHandle; # ... from the directory contents
$lowest_index++ while grep { $lowest_index == num( $_ ) } readdir $dirhandle;
return $lowest_index;
}
# Ready to use!
my $index = min_index ( 'some/dir' , qr/^new project/ );
my $new_project_name = "new project $index";
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 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;