directory tree warning - perl

i have writed some script, that recursively print's directory's content. But it prints warning for each folder. How to fix this?
sample folder:
dev# cd /tmp/testdev# ls -p -Rtest2/testfiletestfile2
./test2:testfile3testfile4
my code:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp/test');
sub browseDir {
my $path = shift;
opendir(my $dir, $path);
while (readdir($dir)) {
next if /^\.{1,2}$/;
if (-d "$path/$_") {
browseDir("$path/$_");
}
print "$path/$_\n";
}
closedir($dir);
}
and the output:
dev# perl /tmp/cotest.pl/tmp/test/test2/testfile3
/tmp/test/test2/testfile4Use of uninitialized value $_ in
concatenation (.) or string at /tmp/cotest.pl line 16./tmp/test/
/tmp/test/testfile/tmp/test/testfile2

May you try that code:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp');
sub browseDir {
my $path = shift;
opendir(my $dir, $path);
while (readdir($dir)) {
next if /^\.{1,2}$/;
print "$path/$_\n";
if (-d "$path/$_") {
browseDir("$path/$_");
}
}
closedir($dir);
}
If you got that error, its because you call browseDir() before use variable $_.

Why not use the File::Find module? It's included in almost all distributions of Perl since Perl 5.x. It's not my favorite module due to the sort of messy way it works, but it does a good job.
You define a wanted subroutine that does what you want and filter out what you don't want. In this case, you're printing pretty much everything, so all wanted does is print out what is found.
In File::Find, the name of the file is kept in $File::Find::name and the directory for that file is in $File::Find::dir. The $_ is the file itself, and can be used for testing.
Here's a basic way of what you want:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
find ( \&wanted, $directory );
sub wanted {
say $File::Find::Name;
}
I prefer to put my wanted function in my find subroutine, so they're together. This is equivalent to the above:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
find (
sub {
say $File::Find::Name
},
$directory,
);
Good programming says not to print in subroutines. Instead, you should use the subroutine to store and return your data. Unfortunately, find doesn't return anything at all. You have to use a global array to capture the list of files, and later print them out:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find (
sub {
push #directory_list, $File::Find::Name
}, $directory );
for my $file (#directory_list) {
say $file;
}
Or, if you prefer a separate wanted subroutine:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find ( \&wanted, $directory );
sub wanted {
push #directory_list, $File::Find::Name;
}
for my $file (#directory_list) {
say $file;
}
The fact that my wanted subroutine depends upon an array that's not local to the subroutine bothers me which is why I prefer embedding the wanted subroutine inside my find call.
One thing you can do is use your subroutine to filter out what you want. Let's say you're only interested in JPG files:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find ( \&wanted, $directory );
sub wanted {
next unless /\.jpg$/i; #Skip everything that doesn't have .jpg suffix
push #directory_list, $File::Find::Name;
}
for my $file (#directory_list) {
say $file;
}
Note how the wanted subroutine does a next on any file I don't want before I push it into my #directory_list array. Again, I prefer the embedding:
find (sub {
next unless /\.jpg$/i; #Skip everything that doesn't have .jpg suffix
push #directory_list, $File::Find::Name;
}
I know this isn't exactly what you asked, but I just wanted to let you know about the Find::File module and introduce you to Perl modules (if you didn't already know about them) which can add a lot of functionality to Perl.

You place a value in $_ before calling browseDir and you expect it the value to be present after calling browseDir (a reasonable expectation), but browseDir modifies that variable.
Just add local $_; to browseDir to make sure that any change to it are undone before the sub exits.
Unrelated to your question, here are three other issues:
Not even minimal error checking!
You could run out of directory handles will navigating a deep directory.
You filter out files ".\n" and "..\n".
Fix:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp/test');
sub browseDir {
my $path = shift;
opendir(my $dh, $path) or die $!;
my #files = readdir($dh);
closedir($dh);
for (#files) {
next if /^\.{1,2}z/;
if (-d "$path/$_") {
browseDir("$path/$_");
}
print "$path/$_\n";
}
}
Finally, why don't use you a module like File::Find::Rule?
use File::Find::Rule qw( );
print "$_\n" for File::Find::Rule->in('/tmp');
Note: Before 5.12, while (readir($dh)) would have to be written while (defined($_ = readdir($dh)))

Related

include/eval perl file into unique namespace defined at runtime

I'm writing a tool that must import a number of other perl config files. The files are not wrapped w/packages and may have similar or conflicting variables/functions. I don't have the ability to change the format of these files, so I must work around what they are. What I was thinking to do was import each into a unique name space, but I've not found a way to do that using do, require, or use. If I don't use dynamic names, just a hardcoded name, I can do it.
Want something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
package $namespace;
do $file;
1;
return;
}
That doesn't work because the package command requires a constant for the name. So then I try something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
eval "package $namespace;do $file;1;"
return;
}
But the contents of the file read by do are placed in the main:: scope not the one I want. The target scope is created, just not populated by the
do. (I tried require, and just a straight cat $file inside the eval as well.)
I'm using Devel::Symdump to verify that the namespaces are built correctly or not.
example input file:
my $xyz = "some var";
%all_have_this = ( common=>"stuff" );
ADDITIONAL CHALLENGE
Using the answer that does the temp file build and do call, I can make this work dynamically as I require. BUT, big but, how do I now reference the data inside this new namespace? Perl doesn't seem to have the lose ability to build a variable name from a string and use that as the variable.
I am not sure why the eval did not work. Maybe a bug? Here is a workaround using a temp file. This works for me:
use strict;
use warnings;
use Devel::Symdump;
use File::Temp;
my $file = './test.pl';
my $namespace = 'TEST';
{
my $fh = File::Temp->new();
print $fh "package $namespace;\n";
print $fh "do '$file';\n";
print $fh "1;\n";
close $fh;
do $fh->filename;
}
Perl's use and require facilities make use of any hooks you might have installed in #INC. You can simply install a hook which looks in a specific location to load modules with a prefix you choose:
package MyIncHook;
use strict;
use warnings;
use autouse Carp => qw( croak );
use File::Spec::Functions qw( catfile );
sub import {
my ($class, $prefix, $location) = #_;
unshift #INC, _loader_for($prefix, $location);
return;
}
sub _loader_for {
my $prefix = shift;
my $location = shift;
$prefix =~ s{::}{/}g;
return sub {
my $self = shift;
my $wanted = shift;
return unless $wanted =~ /^\Q$prefix/;
my $path = catfile($location, $wanted);
my ($is_done);
open my $fh, '<', $path
or croak "Failed to open '$path' for reading: $!";
my $loader = sub {
if ($is_done) {
close $fh
or croak "Failed to close '$path': $!";
return 0;
}
if (defined (my $line = <$fh>)) {
$_ = $line;
return 1;
}
else {
$_ = "1\n";
$is_done = 1;
return 1;
}
};
(my $package = $wanted) =~ s{/}{::}g;
$package =~ s/[.]pm\z//;
my #ret = (\"package $package;", $loader);
return #ret;
}
}
__PACKAGE__;
__END__
Obviously, modify the construction of $path according to your requirements.
You can use it like this:
#!/usr/bin/env perl
use strict;
use warnings;
use MyIncHook ('My::Namespace', "$ENV{TEMP}/1");
use My::Namespace::Rand;
print $My::Namespace::Rand::settings{WARNING_LEVEL}, "\n";
where $ENV{TEMP}/1/My/Namespace/Rand.pm contains:
%settings = (
WARNING_LEVEL => 'critical',
);
Output:
C:\Temp> perl t.pl
critical
You can, obviously, define your own mapping from made up module names to file names.

How to pass an anonymous sub to Find::File

I know I can do this as an expression modifier:
#!/usr/bin/perl -w
use strict;
use File::Find;
sub file_find{
my ($path,$filter) = #_;
find(sub {print $File::Find::name."\n" if /$filter/}, $path);
}
file_find($newdir,'\.txt');
or this which is less readable:
find(sub {if(/$filter/){print $File::Find::name."\n"}}, $path);
But if I wanted to do something like this, how can I do it?
sub file_find{
my ($path,$filter) = #_;
find(\&print, $path);
sub print {
if(/$filter/){ #Variable $filter will not stay shared
print $File::Find::name."\n";
}
}
}
file_find($newdir,'\.txt')
I get 'variable will not stay shared'. I believe I'm supposed to make it an anonymous sub:
my $print = sub {
if(/$filter/){
print $File::Find::name."\n";
}
}
But then I don't know how to pass the reference to the find sub. Perhaps it's somthing silly I'm missing.
Edit: Never mind, this seems to work:
sub file_find{
my ($path,$filter) = #_;
my $subref = sub{
if(/$filter/){
print $File::Find::name."\n";
}
};
find($subref,$path);
}
file_find($newdir,'\.txt');
I had to push the find sub to the bottom! Man I feel so dumb :)
I would separate the subs apart (and rename the print() one as it conflicts with the built-in with the same name!), then you can do something along these lines (if I'm understanding what you want correctly):
use warnings;
use strict;
use File::Find;
file_find('.', '.txt');
sub file_find{
my ($path,$filter) = #_;
my #files = find(sub {my_print($filter)}, $path);
}
sub my_print {
my $filter = shift;
my $fname = $File::Find::name;
if($fname =~ /$filter/){
print "$fname\n";
}
}
However, with that said, File::Find::Rule can make these things very, very easy (particularly handling the file filters as it handles regex natively):
use warnings;
use strict;
use File::Find::Rule;
my $filter = '*.txt';
my $dir = '.';
my #files = File::Find::Rule->file()
->name($filter)
->in($dir);
print "$_\n" for #files;

List all the subroutine names in perl program

I am using more modules in my perl program.
example:
use File::copy;
so likewise File module contains Basename, Path, stat and etc..
i want to list all the subroutine(function) names which is in File Package module.
In python has dir(modulename)
It list all the function that used in that module....
example:
#!/usr/bin/python
# Import built-in module math
import math
content = dir(math)
print content
Like python tell any code for in perl
If you want to look at the contents of a namespace in perl, you can use %modulename::.
For main that's either %main:: or %::.
E.g.:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
sub fish {};
sub carrot {};
print "Stuff defined in Dumper:\n";
print Dumper \%Data::Dumper::;
print "Stuff defined:\n";
print Dumper \%::;
That covers a load of stuff though - including pragmas. But you can check for e.g. subroutines by simply testing it for being a code reference.
foreach my $thing ( keys %:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
And with reference to the above sample, this prints:
sub Dumper
sub carrot
sub fish
So with reference to your original question:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use File::Copy;
print "File::Copy has subs of:\n";
foreach my $thing ( keys %File::Copy:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
Unfortunately you can't do the same thing with the whole File:: namespace, because there's a whole bunch of different modules that could be installed/loaded, but might not be.
You'd have to use e.g. CPAN to check that -
perl -MCPAN -e shell
i /^File::/
Which will list you around 717 modules that are grouped into the File:: tree.
You could look this up on CPAN. Or if you're just after the core modules, then some variant of using Module::CoreList might do what you want.
Something like this:
#!/usr/bin/perl
use strict;
use warnings;
use Module::CoreList;
foreach my $module ( Module::CoreList->find_modules(qr/^File::/) ) {
if ( eval { require $module =~ s|::|/|gr . ".pm" } ) {
print "Module: $module contains\n";
my $key_str = "\%$module\:\:";
my %stuff = eval $key_str;
foreach my $thing ( sort keys %stuff ) {
my $full_sub_path = "$module::$thing";
if ( eval {"defined &$full_sub_path"} ) {
if ( defined &$thing ) {
print "$thing <- $full_sub_path imported by default\n";
}
else {
print "\t$full_sub_path might be loadable\n";
}
}
}
}
else {
print "Module: $module couldn't be loaded\n";
}
}
It's a bit messy because you have to eval various bits of it to test if a module is in fact present and loadable at runtime. Oddly enough, File::Spec::VMS wasn't present on my Win32 system. Can't think why.... :).
Should note - just because you could import a sub from a module (that isn't exported by default) doesn't make it a good idea. By convention, any sub prefixed with an _ is not supposed to be used externally, etc.
My Devel::Examine::Subs module can do this, plus much more. Note that whether it's a method or function is irrelevant, it'll catch both. It works purely on subroutines as found with PPI.
use warnings;
use strict;
use Devel::Examine::Subs;
my $des = Devel::Examine::Subs->new;
my $subs = $des->module(module => 'File::Copy');
for (#$subs){
print "$_\n";
}
Output:
_move
move
syscopy
carp
mv
_eq
_catname
cp
copy
croak
Or a file/full directory. For all Perl files in a directory (recursively), just pass the dir to file param without a file at the end of the path:
my $des = Devel::Examine::Subs->new(file => '/path/to/file.pm');
my $subs = $des->all;
If you just want to print it use the Data::Dumper module and the following method, CGI used as an example:
use strict;
use warnings;
use CGI;
use Data::Dumper;
my $object = CGI->new();
{
no strict 'refs';
print "Instance METHOD IS " . Dumper( \%{ref ($object)."::" }) ;
}
Also note, it's File::Copy, not File::copy.

perl script to count files in windows directory tree

I am new to perl scripting. I am trying to get the count of directories & subdirectories.
So I have searched all the available help on scripting.
But unable get the count of Subdirectories. Below is the script I used.
use strict;
use warnings;
use File::Slurp;
my #dirs = ('.');
my $directory_count = 0;
my $file_count = 0;
my $outfile = 'log.txt';
open my $fh, '>', $outfile or die "can't create logfile; $!";
for my $dir (#dirs) {
for my $file (read_dir ($dir)) {
if ( -d "$dir/$file" ) {
$directory_count++;
}
else {
$file_count++;
}
}
print $fh "Directories: $directory_count\n";
print $fh "Files: $file_count\n";
}
close $fh;
Here, I am unable to identify where to change the command of dir with /s.
Please help it will reduce lot of manual work.
Ravi
Never EVER write your own directory traversal. There are too many pitfalls, gotchas and edge cases. Things like path delimiters, files with spaces, alternate data streams, soft links, hard links, DFS paths... just don't do it.
Use File::Find or if you prefer File::Find::Rule.
As I prefer the former, I'll give an example:
use strict;
use warnings;
use File::Find;
my $dir_count;
my $file_count;
#find runs this for every file in it's traversal.
#$_ is 'current file'. $File::Find::Name is full path to file.
sub count_stuff {
if ( -d ) { $dir_count++ };
if ( -f ) { $file_count++ };
}
find ( \&count_stuff, "." );
print "Dirs: $dir_count\n";
print "Files: $file_count\n";
Here is a script that does it: 1) without global variables; and 2) without adding another sub to the namespace.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;
run(\#ARGV);
sub run {
my $argv = shift;
for my $dir ( #$argv ) {
my $ret = count_files_and_directories( $dir );
printf(
"%s: %d files and %d directories\n",
$dir,
$ret->{files},
$ret->{directories}
);
}
return;
}
sub count_files_and_directories {
my $top = shift;
my %ret = (directories => 0, files => 0);
find(
{
wanted => sub {
-d and $ret{directories} += 1;
-f and $ret{files} += 1;
},
no_chdir => 1,
},
$top,
);
\%ret;
}
It seems simpler to use File::Find::Rule.. For example:
use warnings;
use strict;
use File::Find::Rule;
my #files = File::Find::Rule->new->file->in('.');
my #dirs = File::Find::Rule->new->directory->in('.');

How can I recursively read out directories in Perl?

I want to read out a directory recursively to print the data-structure in an HTML-Page with Template::Toolkit.
But I'm hanging in how to save the Paths and Files in a form that can be read our easy.
My idea started like this
sub list_dirs{
my ($rootPath) = #_;
my (#paths);
$rootPath .= '/' if($rootPath !~ /\/$/);
for my $eachFile (glob($path.'*'))
{
if(-d $eachFile)
{
push (#paths, $eachFile);
&list_dirs($eachFile);
}
else
{
push (#files, $eachFile);
}
}
return #paths;
}
How could I solve this problem?
This should do the trick
use strict;
use warnings;
use File::Find qw(finddepth);
my #files;
finddepth(sub {
return if($_ eq '.' || $_ eq '..');
push #files, $File::Find::name;
}, '/my/dir/to/search');
You should always use strict and warnings to help you debug your code. Perl would have warned you for example that #files is not declared. But the real problem with your function is that you declare a lexical variable #paths on every recursive call to list_dirs and don't push the return value back after the recursion step.
push #paths, list_dir($eachFile)
If you don't want to install additional modules, the following solution should probably help you:
use strict;
use warnings;
use File::Find qw(find);
sub list_dirs {
my #dirs = #_;
my #files;
find({ wanted => sub { push #files, $_ } , no_chdir => 1 }, #dirs);
return #files;
}
The answer by mdom explains how your initial attempt went astray. I would also suggest that you consider friendlier alternatives to File::Find. CPAN has several options. Here's one.
use strict;
use warnings;
use File::Find::Rule;
my #paths = File::Find::Rule->in(#ARGV);
Also see here:
SO answer providing CPAN
alternatives to File::Find.
SO question on directory iterators.
And here is a rewrite of your recursive solution. Things to note: use strict; use warnings; and the use of a scoping block to create a static variable for the subroutine.
use strict;
use warnings;
print $_, "\n" for dir_listing(#ARGV);
{
my #paths;
sub dir_listing {
my ($root) = #_;
$root .= '/' unless $root =~ /\/$/;
for my $f (glob "$root*"){
push #paths, $f;
dir_listing($f) if -d $f;
}
return #paths;
}
}
I think you have problem in the following line in your code
for my $eachFile (glob($path.'*'))
You change the $path variable into $rootpath.
It will store the path correctly.
I use this script to remove hidden files (created by Mac OS X) from my USB Pendrive, where I usually use it to listen music in the car, and any file ending with ".mp3", even when it starts with "._", will be listed in the car audio list.
#!/bin/perl
use strict;
use warnings;
use File::Find qw(find);
sub list_dirs {
my #dirs = #_;
my #files;
find({ wanted => sub { push #files, $_ } , no_chdir => 1 }, #dirs);
return #files;
}
if ( ! #ARGV || !$ARGV[0] ) {
print "** Invalid dir!\n";
exit ;
}
if ( $ARGV[0] !~ /\/Volumes\/\w/s ) {
print "** Dir should be at /Volume/... > $ARGV[0]\n";
exit ;
}
my #paths = list_dirs($ARGV[0]) ;
foreach my $file (#paths) {
my ($filename) = ( $file =~ /([^\\\/]+)$/s ) ;
if ($filename =~ /^\._/s ) {
unlink $file ;
print "rm> $file\n" ;
}
}
you can use this method as recursive file search that separate specific file types,
my #files;
push #files, list_dir($outputDir);
sub list_dir {
my #dirs = #_;
my #files;
find({ wanted => sub { push #files, glob "\"$_/*.txt\"" } , no_chdir => 1 }, #dirs);
return #files;
}