Passing Subroutine to Perl Subroutine - perl

I'm trying to make a subroutine that mimics Perl6/Raku's dir. dir can search directories very easily and quickly, with file tests in a directory.
I'm trying to add a recursive option to dir.
I have a script that can accomplish this, but I'm trying to add a recursive option using File::Find script that I already know works:
use File::Find;
my #files;
find({ wanted => \&process_file, no_chdir => 1 }, '.');
sub process_file {
if ((-f $_) && ($_ =~ m/\.pl$/)) {#various tests on the files
push #files, $_;
# print "This is a file: $_\n";
}
}
However, I want to do everything in a single subroutine.
I have tried this:
use strict;
use warnings FATAL => 'all';
use feature 'say';
use autodie ':all';
use Carp 'confess';
use File::Find 'find';
sub dir { # a Perl5 mimic of Perl6/Raku's "dir"
my %args = ( # default arguments listed below
tests => 'f', dir => '.', regex => '.', recursive => 0,
#_, # argument pair list goes here
);
if ($args{tests} =~ m/[^rwxoRWXOezfdlpSbctugkTB]/){# sMAC returns are non-boolean, and are excluded
confess "There are some unrecognized characters in $args{tests}";
}
my #items = split '', $args{tests};
my $tests = '-' . join (' -', #items);
undef #items;
$args{regex} = qr/$args{regex}/;
opendir my $dh, $args{dir} or die "Can't opendir on $args{dir}: $!";
while (my $item = readdir $dh) {
if (($item !~ $args{regex}) or ($item =~ m/^\.{1,2}$/)) { next }
my $i = "$args{dir}/$item";
if (not defined $i) {
confess "\$i isn't defined.";
}
my $rv = eval "${tests} \$i" || 0;
if ($rv == 0) { next }
if ($args{dir} eq '.') {
push #items, $item
} else {
push #items, $i
}
}
# this is the new part, and what doesn't work
if ($args{recursive} == 1) {
find({
wanted => \sub {
if ((eval "${tests} $_") && ($_ =~ /$args{regex}/)) {
push #items, $_;
}
},
chdir => 1,
'.'
});
}
#items
}
foreach my $pl (dir(recursive => 1, regex => '\.pl$')) {
say $pl
}
this gives an error:
Odd number of elements in anonymous hash at clean.pl line 44
I think that this is because of the find function in the bottom, as the error indicates.
Passing one subroutine to another subroutine is somewhat similar to my question, but I don't see how to apply there to my case.
Passing wanted => sub and wanted => \sub gives the same error.
How can I get this wanted subroutine to pass to find without errors?

Perl tries to use every odd argument as hash key and every even one as hash value, so with an odd number of arguments you get that "odd number of arguments" error cause you put all arguments to find in an anonymous hash ref. The file name / path has no hash key, so move that out of the hashref.
Then pass the wanted routine like this:
wanted => sub { ... }
That said, my File::Find only knows no_chdir, not chdir, so you probably want to switch the value.
This works for me:
find(
{
wanted => sub {
if ((eval "${tests} $_") && ($_ =~ /$args{regex}/)) {
push #items, $_;
}
},
no_chdir => 0,
},
'.' # File outside the hash ref
);

Related

How to distinguish between "0" and NULL in perl?

Here we are looking for the string "reftext" in the given file. The line next to this contains a string with 3 integers. So we are extracting them in #all_num. We are printing the value of #all_num[2] only if is not NULL. But the logic used here doesn't print #all_num[2] even if it has 0.
#!/usr/bin/perl
open( READFILE, "<myfile.txt" );
#list = <READFILE>;
$total_lines = scalar #list;
for ( $count = 0; $count < $total_lines; $count++ ) {
if (#list[ $count =~ /reftext/ )
{
#all_num = #list[ $count + 1 ] =~ /(\d+)/g;
if ( #all_num[2] != NULL ) {
print "#all_num[2]\n";
}
}
}
Hope this helps,
use strict;
use warnings;
my #fvals = (
[ i => undef ],
[ j => 0 ],
[ k => "" ],
);
for my $r (#fvals) {
my ($k, $v) = #$r;
if (!defined($v)) { print "$k is undef\n"; }
elsif (!length($v)) { print "$k is empty string\n"; }
# elsif (!$v) { print "$k is zero\n"; }
# recognizes zero value in "0.0" or "0E0" notation
elsif ($v == 0) { print "$k is zero\n"; }
}
output
i is undef
j is zero
k is empty string
Perl does not include a NULL, so the line
if(#all_num[2]!= NULL)
is nonsensical in Perl. (More accurately, it attempts to locate a sub named NULL and run it to get the value to compare against #all_num[2], but fails to do so because you (presumably) haven't defined such a sub.) Note that, if you had enabled use strict, this would cause a fatal error instead of pretending to work. This is one of the many reasons to always use strict.
Side note: When you pull a value out of an array, it's only a single value, so you should say $all_num[2] rather than #all_num[2] when referring to the third element of the array #all_num. (Yes, this is a little confusing to get used to. I hear that it's been changed in Perl 6, but I'm assuming you're using Perl 5 here.) Note that, if you had enabled use warnings, it would have told you that "Scalar value #all_num[2] better written as $all_num[2]". This is one of the many reasons to always use warnings.
If you want to test whether $all_num[2] contains a value, the proper way to express that in Perl is
if (defined $all_num[2])
This is how your program would look using best practices
You should
Always use strict and use warnings, and declare all your variables with my
Use the three-parameter form of open
Check that open calls succeeded, and include $! in the die string if not
Use a while loop to process a file one line at a time, in preference to reading the entire file into memory
#!/usr/bin/perl
use strict;
use warnings;
open my $fh, '<', 'myfile.txt' or die $!;
while ( <$fh> ) {
next unless /reftext/;
my $next_line = <$fh>;
my #all_num = $next_line =~ /\d+/g;
print "$all_num[2]\n" if defined $all_num[2];
}
Try this:
#!/usr/bin/perl
use warnings;
use strict;
open(READFILE, "<", "myfile.txt") or die $!;
my #list = <READFILE>;
my $total_lines = scalar #list;
close (READFILE);
for(my $count=0; $count<$total_lines; $count++)
{
if($list[$count] =~ /reftext/)
{
my #all_num = $list[$count+1] =~ /(\d+)/g;
if($all_num[2] ne '')
{
print "$all_num[2]\n";
}
}
}
To check a variable is null or not:
if ($str ne '')
{
print $str;
}
or better:
my ($str);
$str = "";
if (defined($str))
{
print "defined";
}
else
{
print "not defined";
}
If the other answers do not work, try treating the variable as a string:
if ( $all_num[2] == 'null' && length($all_num[2]) == 4 ){
# null
} else {
# not null
}
As with any code you write, be sure to test your code.

String Parsing for nested parenthesis in perl

The issue is when I try to compare the input to the output file, i am unable to handle the nesting of the parenthesis, and the complexity needs to be very low. is there a parsing module for this? compatible to 5.8.4. I found modules but they needed at least 5.10.:(
Input
(K1=V1,K2=V2,K3=V3(K2=V2.K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)
OUTPUT FILE
(K0=V0,K1=V1,K2=V2,K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14),K15=V15,K6=V6(K18=V18,K7=V7,K19=V19,K8=V8(K20=V20,K9=V9,K16=V16,K10=V10,K21=V21)K11=V11)K12=V12,K13=V13,K22=V22)
I need to pick up each key value pair from input and one by one verify from the output file that the value is the same. if not
I need to store the key with the existing value.( The issue is with the nesting )
INPUT
K3=V3(K2=V2,K5=V5)
OUTPUT
K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14)
The issue is that "K2=V2" inside the V3 value is to be checked inside the V3 value in the output file. So I cannot just use a regular expression to do that as K2=V2 may appear outside the V3 parenthesis too.
I was trying to create a hash of a hash of a hash but failed. could someone suggest a way I could achieve this?
The following code builds the hash of hashes. Note that values (V3) are lost if they contain an inner hash.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub to_hash {
my $string = shift;
$string =~ s/^\( | \)$//gx; # Remove the outer parentheses.
my #stack = {};
my #keys;
while (length $string) {
$string =~ s/^([^,=()]+) = ([^(),]*)//x or die $string;
my ($key, $value) = ($1, $2);
$stack[-1]{$key} = $value;
next if $string =~ s/^,//;
if ($string =~ s/^\(//) {
push #stack, {};
push #keys, $key;
} elsif ($string =~ s/^\),?//) {
my $last = pop #stack;
$stack[-1]{ pop #keys } = $last;
}
}
return $stack[0]
}
my $input = '(K1=V1,K2=V2,K3=V3(K2=V2,K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)';
print Dumper to_hash($input);
Output
$VAR1 = {
'K2' => 'V2',
'K13' => 'V13',
'K6' => {
'K7' => 'V7',
'K8' => {
'K9' => 'V9',
'K10' => 'V10'
},
'K11' => 'V11'
},
'K3' => {
'K2' => 'V2',
'K5' => 'V5'
},
'K12' => 'V12',
'K1' => 'V1'
};
Nested parens either suggests an application of Text::Balanced and its extract_bracketed function, or building yourself a little parser subclass on Parser::MGC. Using the latter to build a little "convert string into data structure" parser is usually pretty straightforward for simple examples like this.

Push into end of hash in Perl

So what I am trying to do with the following code is push a string, let's say "this string" onto the end of each key in a hash. I'm completely stumped on how to do this. Here's my code:
use warnings;
use strict;
use File::Find;
my #name;
my $filename;
my $line;
my #severity = ();
my #files;
my #info = ();
my $key;
my %hoa;
my $xmlfile;
my $comment;
my #comments;
open( OUTPUT, "> $ARGV[0]" );
my $dir = 'c:/programs/TEST/Test';
while ( defined( $input = glob( $dir . "\\*.txt" ) ) ) {
open( INPUT, "< $input" );
while (<INPUT>) {
chomp;
if (/File/) {
my #line = split /:/;
$key = $line[1];
push #{ $hoa{$key} }, "Filename\n";
}
if ( /XML/ ... /File/ ) {
$xmlfile = $1;
push #{ $hoa{$key} }, "XML file is $xmlfile\n";
}
if (/Important/) {
push #{ $hoa{$key} }, "Severity is $_\n";
}
if (/^\D/) {
next if /Important/;
push #{ $hoa{$key} }, "Given comment is $_\n";
}
push #{ $hoa{$key} }, "this string\n";
}
}
foreach my $k ( keys %hoa ) {
my #list = #{ $hoa{$k} };
foreach my $l (#list) {
print OUTPUT $l, "\n";
}
}
}
close INPUT;
close OUTPUT;
Where I have "this string" is where I was trying to push that string onto the end of the array. However, what ended up happening was that it ended up printing "this string" three times, and not at the end of every key like I wanted. When I tried to put it outside the while() loop, it said that the value of $key was not initialized. So please, any help? And if you need any clarification on what I'm asking, just let me know. Thank you!
No offence, but there are so many issues in this code I don't even know where to start...
First, the 'initialization block' (all these my $something; my #somethings lines at the beginning of this script) is not required in Perl. In fact, it's not just 'redundant' - it's actually confusing: I had to move my focus back and forth every time I encountered a new variable just to check its type. Besides, even with all this $input var is still not declared as local; it's either missing in comments, or the code given has omissions.
Second, why do you declare your intention to use File::Find (good) - but then do not use it at all? It could greatly simplify all this while(glob) { while(<FH>) { ... } } routine.
Third, I'm not sure why you assign something to $key only when the line read is matched by /File/ - but then use its value as a key in all the other cases. Is this an attempt to read the file organized in sections? Then it can be done a bit more simple, either by slurp/splitting or localizing $/ variable...
Anyway, the point is that if the first line of the file scanned is not matched by /File/, the previous (i.e., from the previous file!) value is used - and I'm not quite sure that it's intended. And if the very first line of the first file is not /File/-matched, then an empty string is used as a key - again, it smells like a bug...
Could you please describe your task in more details? Give some test input/output results, perhaps... It'd be great to proceed in short tasks, organizing your code in process.
Your program is ill-conceived and breaks a lot of good practice rules. Rather than enumerate them all, here is an equivalent program with a better structure.
I wonder if you are aware that all of the if statements will be tested and possibly executed? Perhaps you need to make use of elsif?
Aside from the possibility that $key is undefined when it is used, you are also setting $xmlfile to $1 which will never be defined as there are no captures in any of your regular expressions.
It is impossible to tell from your code what you are trying to do, so we can help you only if you show us your output, input and say how to derive one from the other.
use strict;
use warnings;
use File::Find;
my ($outfile) = #ARGV;
my $dir = 'c:/programs/TEST/Test';
my %hoa;
my $key;
while (my $input = glob "$dir/*.txt") {
open my $in, '<', $input or die $!;
while (<$in>) {
chomp;
if (/File/) {
my $key = (split /:/)[1];
push #{ $hoa{$key} }, "Filename\n";
}
if (/XML/ ... /File/) {
my $xmlfile = $1;
push #{ $hoa{$key} }, "XML file is $xmlfile\n";
}
if (/Important/) {
push #{ $hoa{$key} }, "Severity is $_\n";
}
if (/^\D/) {
next if /Important/;
push #{ $hoa{$key} }, "Given comment is $_\n";
}
push #{ $hoa{$key} }, "this string\n";
}
close $in;
}
open my $out, '>', $outfile or die $!;
foreach my $k (keys %hoa) {
foreach my $l (#{ $hoa{$k} }) {
print $out $l, "\n";
}
}
close $out;
I suspect based on your code, that the line where $key is set is not called each time through the loop, and that you do not trigger any of the other if statements.
This would append "this string" to the end of the array. Based on that you are getting 3 of the "this strings" at the end of the array, I would suspect that two lines do not go through the if (/FILE/) or any of the other if statements. This would leave the $key value the same and at the end, you would append "this string" to the array, using whatever the last value of $key was when it was set.
This will append the string "this string" to every element of the hash %hoa, which elements are array refs:
for (values(%hoa)) { push #{$_}, "this string"; }
Put that outside your while loop, and you'll print "this string" at the end of each element of %hoa.
It will autovivify array refs where it finds undefined elements. It will also choke if it cannot dereference an element as an array, and will manipulate arrays by symbolic reference if it finds a simple scalar and is not running under strict:
my %autoviv = ( a => ['foo'], b => undef );
push #$_, "PUSH" for values %autoviv; # ( a => ['foo', 'PUSH'], b => ['PUSH'] )
my %fatal = ( a => {} );
push #$_, "PUSH" for values %fatal; # FATAL: "Not an ARRAY reference at..."
my %dangerous = (a => "foo");
push #$_, "PUSH" for values %dangerous; # Yikes! #foo is now ("PUSH")
use strict;
my %kablam = (a => "foo");
push #$_, "PUSH" for values %kablam; # "Can't use string ("foo") as an ARRAY ref ..."
As I understand it, traverse the hash with a map command to modify its keys. An example:
EDIT: I've edited because I realised that the map command can be assigned to the same hash. No need to create a new one.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my %hash = qw|
key1 value1
key2 value2
key3 value3
|;
my %hash = map { $_ . "this string" => $hash{ $_ } } keys %hash;
print Dump \%hash;
Run it like:
perl script.pl
With following output:
$VAR1 = {
'key3this string' => 'value3',
'key2this string' => 'value2',
'key1this string' => 'value1'
};

how to use hashes by calling the value in perl

I'm currently writing a script to check the existance of files reside in several directories. I'm writing in hash and plan to assign same numeric number to those directories that need to perform same subroutines. And thus I'll call by the value names. In the other words, those directories match the value will do same subroutine else it will be dump into a list so that it will be print out in summary later. I'm writing the script as below but it seem doesn't perform correctly as mit seem doesn't capture the value at all. May I know where goes wrong here? Note I want to call the hash by value but not key.
my %hashDir = (dirA => 1, dirB => 2, dirC =>3 , dirD => 1, dirE =>2, dirF =>1);
my $key = "";
my $value = "" ;
my $buf ;
my $d = "$basedir/$buf";
while (($key, $value) = each (%hashDir)) {
if (exists $hashDir{'1'}) {
print "test1\n" ;
subroutine1() ;
} elsif (exists $hashDir{'2'}) {
print "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" ;
subroutine2() ;
} else {
$missingdir .= "\"$buf\" " ;
print "test3\n" ;
}
}
I don't think you understand how to access elements in a hash. When you do exists $hashDir{'1'}, you're looking to see if '1' is a key in the hash. It is not. I think you want to do:
if ($hashDir{$key} == 1)
or since you already have the value,
if ($value == 1)
Use meaningful names rather than $key/$value.
Use a "dispatch table" to decide what subroutine to call.
#!/usr/bin/perl
use warnings;
use strict;
print "Enter path to top-level directory: ";
chomp(my $basedir = <STDIN>);
chdir $basedir or die "could not cd to '$basedir' $!";
my %hashDir = (
dirA => 1,
dirB => 2,
dirC => 3,
dirD => 1,
dirE => 2,
dirF => 1,
);
my %dispatch = (
1 => \&subroutine1,
2 => \&subroutine2,
3 => \&subroutine3,
);
my #missing;
while ( my($dir, $group) = each (%hashDir) ){
if (-d $dir) {
$dispatch{$group}->($dir);
}
else {
push #missing, $dir;
}
}
print 'Missing dirs: ', join(', ', #missing), "\n" if #missing;
sub subroutine1 { warn "subroutine1() got called for $_[0] directory\n" }
sub subroutine2 { warn "subroutine2() got called for $_[0] directory\n" }
sub subroutine3 { warn "subroutine3() got called for $_[0] directory\n" }

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;
}