Perl Get Parent Folder Name - perl

What is the solution to get the name of the parent directory using File::Find. I know how to get only the filename or only the directory path but I don't know how to do this for the last containing directory.
For example, if the directory is /dir_1/dir_2/dir_3/.../dir_n/*.txt I need to get the 'dir_n' name.
use strict;
use warnings;
use File::Find;
my $dir = "some_path";
find(\&file_handle, $dir);
sub file_handle {
/\.txt$/ or return;
my $fd = $File::Find::dir;
my $fn = $File::Find::name;
# ...
}

Given the directory path, you then apply File::Basename (another core module) to the path to obtain the last portion of the directory.
use strict;
use warnings;
use File::Find;
use File::Basename;
my $dir = "some_path";
find(\&file_handle, $dir);
sub file_handle {
/\.txt$/ or return;
my $fd = $File::Find::dir;
my $fn = $File::Find::name;
my $dir = basename($fd);
# ....
}

#!/usr/local/bin/perl -w
use strict;
use File::Basename;
use Cwd 'abs_path';
my $f = "../some/path/to/this_directory/and_filename";
my $d = basename(dirname(abs_path($f)));
say $d;
returns "this_directory"

You can just split and grab the second-to-last element in the array:
my $fname = "/folder/sub-folder/filename.bin";
my #parts = split('/', $fname);
if( #parts > 1 ) {
return $parts[#parts - 2];
} else {
return '/';
}

If you are willing to install non-core modules, the Path::Class can come handy:
use Path::Class;
dir("some_dir")->recurse(callback => sub {
my $file = shift;
return if $file->is_dir;
return if $file =~ /\.txt$/i;
my $fn = $file->basename;
my $fd = $file->parent;
my $dir = $file->parent->parent;
});
It gives you handy objects instead of strings and imo nice operations on them.

Related

Find::File to search a directory of a list of files

I'm writing a Perl script and I'm new to Perl -- I have a file that contains a list of files. For each item on the list I want to search a given directory and its sub-directories to find the file return the full path. I've been unsuccessful thus far trying to use File::Find. Here's what I got:
use strict;
use warnings;
use File::Find;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
my #file_list;
find(\&wanted, $directory);
sub wanted {
open (FILE, $input_file);
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
close (FILE);
return #file_list;
}
I find File::Find::Rule a tad easier and more elegant to use.
use File::Find::Rule;
my $path = '/some/path';
# Find all directories under $path
my #paths = File::Find::Rule->directory->in( $path );
# Find all files in $path
my #files = File::Find::Rule->file->in( $path );
The arrays contain full paths to the objects File::Find::Rule finds.
File::Find is used to traverse a directory structure in the filesystem. Instead of doing what you're trying to do, namely, have the wanted subroutine read in the file, you should read in the file as follows:
use strict;
use warnings;
use vars qw/#file_list/;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
open FILE, "$input_file" or die "$!\n";
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
# do what you need to here with the #file_list array
Okay, well re-read the doc and I misunderstood the wanted subroutine. The wanted is a subroutine that is called on every file and directory that is found. So here's my code to take that into account
use strict;
use warnings;
use File::Find;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
my #file_list;
open (FILE, $input_file);
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
close (FILE);
find(\&wanted, $directory);
sub wanted {
if ( $_ ~~ #file_list ) {
print "$File::Find::name\n";
}
return;
}

Perl search for specific subdirectory then process

So for the program I am writing, what I would like for it to do is search through all of the subdirectories within a directory. If the subdirectory name contains a word, let's say "foo", then the program will open this subdirectory and perform a function on the files within the subdirectory. Can anybody give me some help on how to go about this? it also needs to be recursive. Thanks in advance
This can be done using the File::Find module, but I believe Path::Class is superior even though it isn't a core module and will likely need installing.
This program finds the files wanted and calls process to process them. At present the process subroutine simply prints the name of the file for testing.
use strict;
use warnings;
use Path::Class;
my $dir = dir '/path/to/root/directory';
$dir->recurse(callback => sub {
my $node = shift;
return if $node->is_dir;
my $parent = $node->parent;
if ($parent->basename =~ /foo/) {
process($node);
}
});
sub process {
my $file = shift;
print $file, "\n";
}
Update
If you prefer, this program performs the same task using File::Find.
use strict;
use warnings;
use File::Find;
use File::Basename qw/ basename /;
my $dir = '/path/to/root/directory';
find(sub {
return unless -f;
if (basename($File::Find::dir) =~ /foo/) {
process($File::Find::name);
}
}, $dir);
sub process {
my $file = shift;
print $file, "\n";
}
Update
As requested, here is a further solution using Path::Class::Rule for comparison. As daxim suggested the code is a little shorter.
use strict;
use warnings;
use Path::Class::Rule;
my $rule = Path::Class::Rule->new;
$rule->file->and(sub { $_->parent->basename =~ /foo/ });
my $next = $rule->iter('/path/to/root/directory');
while ( my $file = $next->() ) {
process($file);
}
sub process {
my $file = shift;
print $file, "\n";
}

change the directory and grab the xml file to parse certain data in perl

I am trying to parse specific XML file which is located in sub directories of one directory. For some reason i am getting error saying file does not exists. if the file does not exist it should move on to next sub directory.
HERE IS MY CODE
use strict;
use warnings;
use Data::Dumper;
use XML::Simple;
my #xmlsearch = map { chomp; $_ } `ls`;
foreach my $directory (#xmlsearch) {
print "$directory \n";
chdir($directory) or die "Couldn't change to [$directory]: $!";
my #findResults = `find -name education.xml`;
foreach my $educationresults (#findResults){
print $educationresults;
my $parser = new XML::Simple;
my $data = $parser->XMLin($educationresults);
print Dumper($data);
chdir('..');
}
}
ERROR
music/gitar/education.xml
File does not exist: ./music/gitar/education.xml
Using chdir the way you did makes the code IMO less readable. You can use File::Find for that:
use autodie;
use File::Find;
use XML::Simple;
use Data::Dumper;
sub findxml {
my #found;
opendir(DIR, '.');
my #where = grep { -d && m#^[^.]+$# } readdir(DIR);
closedir(DIR);
File::Find::find({wanted => sub {
push #found, $File::Find::name if m#^education\.xml$#s && -f _;
} }, #where);
return #found;
}
foreach my $xml (findxml()){
say $xml;
print Dumper XMLin($xml);
}
Whenever you find yourself relying on backticks to execute shell commands, you should consider whether there is a proper perl way to do it. In this case, there is.
ls can be replaced with <*>, which is a simple glob. The line:
my #array = map { chomp; $_ } `ls`;
Is just a roundabout way of saying
chomp(my #array = `ls`); # chomp takes list arguments as well
But of course the proper way is
my #array = <*>; # no chomp required
Now, the simple solution to all of this is simply to do
for my $xml (<*/education.xml>) { # find the xml files in dir 1 level up
Which will cover one level of directories, with no recursion. For full recursion, use File::Find:
use strict;
use warnings;
use File::Find;
my #list;
find( sub { push #list, $File::Find::name if /^education\.xml$/i; }, ".");
for (#list) {
# do stuff
# #list contains full path names of education.xml files found in subdirs
# e.g. ./music/gitar/education.xml
}
You should note that changing directories is not required, and in my experience, not worth the trouble. Instead of doing:
chdir($somedir);
my $data = XMLin($somefile);
chdir("..");
Simply do:
my $data = XMLin("$somedir/$somefile");

How do I use chdir to traverse subdirectories and parse XML files?

I want to write a script that traverses a directory and its subdirectories, grabs all the XML files and parses them. I am having trouble with chdir. This works fine:
my $search = "/home/user/books";
chdir($search) or die "cant change dir to $search $!";
system("ls");
But I want the user to decide the path where he want to search it so I am using Getopt::Long:
use strict;
use warnings;
use Data::Dumper;
use XML::Simple;
use Getopt::Long;
my $outputFile = '';
my $searchPath = "";
my $debug = 0;
GetOptions('outputFile=s' => \$outputFile, 'searchPath=s' => \$searchPath);
if ($outputFile eq '' or $searchPath = '') {
die("parameter --outpulFile=s is required.");
}
$searchPath =~ s/\/*$/\//;
my #founddirs = `cd $searchPath`;
foreach my $foundfiles (#founddirs) {
print $foundfiles;
chdir($foundfiles) or die "cant change dir to $searchPath $!";
chdir('..');
}
Command to run:
perl sample.pl --outputFile=books.txt --searchPath=/home/user/june18
I want to grab all the recursive.xml files from the subdirectories and parse them. Does anyone know how this can be done?
A couple of issues here:
$searchPath = '' is setting the search path to an empty string during the input validation. Use eq instead (not ==)
#founddirs will contain nothing since the backtick operator will return nothing. This is because
my #founddirs = `cd $searchPath`;
does not print found directories that are separated by newlines. Perhaps you're after ls $searchPath
On a side note, why not use File::Find instead?
use strict;
use warnings;
use File::Find;
use Getopt::Long;
my $outputFile;
my $searchPath;
GetOptions(
'outputFile=s' => \$outputFile,
'searchPath=s' => \$searchPath,
);
die "Usage : perl sample.pl -outputFile -searchPath\n"
unless $outputFile && $searchPath;
die "No such directory found: $searchPath\n" unless -d $searchPath;
find( sub { print "$File::Find::name\n" if /$outputFile/ }, $searchPath );
#!/usr/bin/perl --
use strict; use warnings;
use Data::Dump qw/ dd /;
use File::Find::Rule qw/ find /;
my #files = find(
file =>
name => '*.xml',
in => \#ARGV
);
dd \#files;
__END__
$ perl ffrule
[]
$ perl ffrule ../soap
[
"../soap/ex1.xml",
"../soap/ex2.xml",
"../soap/ex3.xml",
]

Script to rename files with the name of the folder?

I want to recursively rename files by prepending the folder name in front of it. Ex: c:\test\foo\a.txt would become c:\test\foo\foo-a.txt.
The following Perl script may work for you:
#!/usr/bin/env perl
use strict;
use warnings;
use File::Basename;
use File::Find;
use File::Spec;
sub rename {
my ($dir_name) = ( File::Spec->splitdir($File::Find::dir) )[-1];
my $file_name = basename $_;
if ( -f $_ ) {
$file_name = "$dir_name-$file_name";
rename $_, File::Spec->catdir( $File::Find::dir, $file_name );
}
}
find { 'wanted' => \&rename, 'no_chdir' => 1 }, 'C:/test/foo';
References:
File::Basename
File::Find
File::Spec
use File::Find::Rule qw( );
use Path::Class qw( dir file );
my $base = dir('.')->absolute;
for my $qfn (File::Find::Rule->file->in($base)) {
my $file = file($qfn);
my $dir = $file->dir;
my $src = $file;
my $dst = $dir->file($dir->basename . '-' . $file->basename);
if (-e $dst) {
warn("Can't rename $src to $dst: Already exists\n");
}
elsif (!rename($src, $dst)) {
warn("Can't rename $src to $dst: $!\n");
}
}
use strict;
use warnings;
use File::Spec;
use File::Copy qw(move);
use File::Glob qw(:glob);
my $folder_path = qw( c:\test\foo\ );
my #file_paths = bsd_glob( $folder_path . '*' );
foreach my $old_path (#file_paths) {
if ( -f $old_path ) {
my ( $volume, $directories, $file ) = File::Spec->splitpath($old_path);
my #dirs = File::Spec->splitdir($directories);
my $prepend;
while ( !( $prepend = pop #dirs ) ) { } # see notes below
my $new_fname = $prepend . '-' . $file;
my $new_path = File::Spec->catpath( $volume, $directories, $new_fname );
move( $old_path, $new_path );
}
}
I use while to pop the last directory name before the filename because splitdir has a caveat on Windows. It looks like you are dealing with a Windows file.
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use File::Find;
use File::Spec;
($#ARGV == 0) or die "Usage: $0 [directory]\n";
my $input_file_dir = $ARGV[0];
sub process_file
{
my $dir_name = (File::Spec -> splitdir ($File::Find::dir)) [-1];
my $file_name = basename $_;
my $extension = ($file_name =~ m/([^.]+)$/)[0];
if ( -f $_ )
{
print "$dir_name.$extension\n";
rename $_, "$dir_name.$extension";
}
}
finddepth { 'wanted' => \&process_file, 'no_chdir' => 0 }, $input_file_dir;