I've written a very simple script to delete symlinks in a directory, then create new ones linking to files in another directory (files modified within 10 days).
The script worked pretty good, but I thought I'd start showing some output, more specifically only when a $debug (or $quiet) argument is given. This has been giving me some grief, and I don't understand why I'm struggling with this seemingly easy task.
I'm thinking it is because the 'if($debug)' is used within the short circuit of the find sub. Without any conditional logic, it works fine (as seen in the 2nd find func).
Any thoughts at all will be very much appreciated, thanks.
ERROR:
syntax error at symlinksUpdater.pl line 25,
near "if" syntax error at symlinksUpdater.pl line 26, near "}"
Execution of symlinksUpdater.pl aborted due to compilation errors.
CODE:
#!/usr/bin/perl
use Getopt::Long;
use File::Find;
use Cwd;
my $symDir = getcwd();
my $archiveDir;
my $clearDynamic = 1;
my $debug= '';
my $dryRun ='';
GetOptions ("dynamicDir|s=s" => \$symDir,
"archiveDir|a=s" => \$archiveDir,
"clear|c!" => \$clearDynamic,
"debug|d!" => \$debug,
"dryRun!" => \$dryRun
);
print "DEBUG MODE\n" if $debug;
if ($clearDynamic) {
find(sub {
-l &&
unlink &&
if($debug) {print "DELETE: $_";} #LINE 25
}, "$symDir"); }
find(sub {
-f &&
int(-M _) < 10 &&
symlink($File::Find::name, $symDir."/".$_) &&
print "$symDir/$_ -> $File::Find::name";
#(printf("\n%s/%s -> %s", $symDir, $_, $File::Find::name) if (defined $debug);
}, "$archiveDir");
The operand of && must be an expression, not a statement. Anyway, all you need is
find(sub {
-l && unlink && $debug && print("DELETE: $_");
}, $symDir);
But I find the following far more readable:
find(sub {
if (-l) {
if (unlink) {
print("DELETE: $_") if $debug;
}
}
}, $symDir);
It also allows for easy error handling (else { warn ... }).
Try wrapping the if statement in a do block like this:
if ($clearDynamic) {
find(
sub {
-l &&
unlink &&
do { if($debug) {print "DELETE: $_";} } #LINE 25
}, "$symDir"
);
}
A prefix if block with curly braces can't stand alone as a statement the way other constructs can. You could also use a postfix if like this:
... unlink && (print "DELETE: $_" if $debug)
The parentheses clarify that the print should only happen if $debug is true rather than that the entire string of && conditions is contingent on $debug.
perldoc perlsyn explains "Compound Statements" (e.g.: if {...}) and "Statement Modifiers" (e.g.: ... if EXPR). I didn't find anything in that document which explicitly says that a compound statement can't be used as an expression, I just know from experience that it can't.
Related
I'm a beginner and confused about what's happening inside this Perl subroutine.
I'm using only global variables to simplify things, but it's still not working.
I'm simply trying to print a file's read, write and executable attributes using the file test operators with IF statements.
Can anyone point out the problem for me?
Louie
sub getfileattributes {
if (-r $file) {
$attributes[0] = "readable";
} else { $attributes[0] = "not readable"; }
if (-w _) {
$attributes[1] = "writable";
} else { $attributes[1] = "not writable"; }
if (-x _) {
$attributes[2] = "executable";
} else { $attributes[2] = "not executable"; }
}
my #attributes;
my $file;
foreach $file (#ARGV) {
&getfileattributes;
printf "The file $file is %s, %s and %s\n", #attributes;
}
Using global variables is usually quite bad and points to a design error. In this case, the error seems to be that you don't know how to pass arguments to a sub.
Here is the pattern in Perl:
sub I_take_arguments {
# all my arguments are in #_ array
my ($firstarg, $secondarg, #rest) = #_;
say "1st argument: $firstarg";
say "2nd argument: " .($firstarg+1). " (incremented)";
say "The rest is: [#rest]";
}
Subs are invoked like
I_take_arguments(1, 2, "three", 4);
(Do not invoke them as &nameOfTheSub, this makes use of very special behaviour you don't usually want.)
This would print
1st argument: 1
2nd argument: 3
The rest is: [three 4]
Subroutines can return values, either with the return statement or as the value of the last statement that is executed. These subs are equivalent:
sub foo {return "return value"}
sub bar {"return value"}
I would write your getfileattributes as
sub getFileAttributes {
my ($name) = #_;
return
-r $name ? "readable" : "not readable",
-w $name ? "writable" : "not writable",
-x $name ? "executable" : "not executable";
}
What is happening here? I take an argument $name and then return a list of values. The return keyword could be omitted. The return takes a list of values and does not require parens, so I leave them out. The TEST ? TRUE-STATEMENT : FALSE-STATEMENT operator is known from other languages.
Then, in your loop, the sub would be invoked like
for my $filename (#ARGV) {
my ($r, $w, $x) = getFileAttributes($filename);
say "The file $filename is $r, $w and $x";
}
or
foreach my $file (#ARGV) {
my #attributes = getFileAttributes($file);
printf "The file $file is %s, %s and %s\n", #attributes;
}
Notes:
say is like print, but adds a newline at the end. To use it, you have to have a Perl > 5.10 and you should use 5.010 or whatever version or use feature qw(say).
always use strict; use warnings; unless you know better for sure.
Often, you can write programs without assigning to a variable twice (Single assignment form). This can make reasoning about control flow much easier. This is why global variables (but not global constants) are bad.
You are not actually using global varaibles. My scopes the variables them local to the main routine, so when you call the subroutine, $file and #attributes are scoped to the subroutine, not to the main routine.
Change my to our for $file and #attributes to make the variables global and available to the subroutine.
You can check this for yourself by using the -d argument for perl to run it in the debugger and check the values of the items.
In my program I am passing a list of file names from command-line to my program, and checking whether each file is - executable, readable and writable..
I am using foreach-when statement for the above problem.. But there seems to be some problem in the use of when and default statements, which may be I'm not using correctly, but its giving me unexpected result..
Here's my code: -
#!/perl/bin
use v5.14;
use warnings;
foreach (#ARGV) {
say "*************Checking file $_ *******************";
when (-r $_) { say "File is Readable"; continue; }
when (-w $_) { say "File is Writable"; continue; } # This condition is true
when (-x $_) { say "File is Executable" } # This condition is false
default { say "None of them" } # Executed
}
I have added a continue, only to the first two when to make perl check for all the conditions regardless of the name of the file..
Also, I haven't added a continue to the second last when, because I only want my default to be executed if none of the when is executed..
The problem here is, if the last when condition is false, it will not enter the block, and then it goes on to execute the default even though my first two when statements are satisfied.
I checked the reason of this problem by changing the order of my when, and saw that if only the last when is executed, it will see that there is no continue, and hence it will not execute the default statement..
So, in the above code, I have swapped -x and -r.. My file is readable, so last when in this case will be executed.. And then my default statement is not executed..
#!/perl/bin
use v5.14;
use warnings;
foreach (#ARGV) {
say "*************Checking file $_ *******************";
when (-x $_) { say "File is Executable"; continue; }
when (-w $_) { say "File is Writable"; continue; }
when (-r $_) { say "File is Readable" } # This condition is true
default { say "None of them" } # Not executed
}
So, I want to ask, how to handle these kinds of situation.. I want it to work like the way for which given-when statement was added to Perl.. It should check all the when, and skip the default if at least one when is executed..
Since default isn't an "else condition" but can be seen as a when that always matches, it's not really a good match for what you're trying to do. In your default condition, you don't know anything about earlier matches in that block, and you can't break out of the topicalizer earlier without knowing if any later when will match, so either you have to "hack it" with a boolean that says one of the earlier matched, or just exchange it for a when that takes care of the "left over" condition;
foreach (#ARGV) {
say "*************Checking file $_ *******************";
when (-r $_) { say "File is Readable"; continue; }
when (-w $_) { say "File is Writable"; continue; }
when (-x $_) { say "File is Executable"; continue; }
when (!-r && !-w && !-x) { say "None of them" }
}
Note that perl does not cache stat results by filename, so you are going to be stating the same file over and over. It does provide a "_" cache of the last stat issued, so you can:
stat $file;
if ( -r _ ) { ... }
if ( -w _ ) { ... }
A switch statement is best used for "one of these will match". Using it for a situation where multiple cases may match is leading to having to abuse the logical structure to make it work. Having to use fall throughs, and having your cases be order dependent, is a red flag.
A better choice might be to create an array of matches.
for my $file (#files) {
my #flags;
push #flags, "readable" if -r $file;
push #flags, "writable" if -w $file;
push #flags, "executable" if -x $file;
if( #flags ) {
printf "%s is %s\n", $file, join(", ", #flags);
}
else {
say "$file has no flags set";
}
}
Building an array has the nice side effect of being more flexible. You can print out one line or several. It also avoids having to repeat all the flags again at the end, which violates the DRY Principle.
An alternative would be to use a do block to set a flag.
for my $file (#files) {
my $has_flags;
do { say "$file is readable"; $has_flags = 1; } if -r $file;
do { say "$file is writable"; $has_flags = 1; } if -w $file;
do { say "$file is executable"; $has_flags = 1; } if -x $file;
if( !$has_flags ) {
say "$file has no flags set";
}
}
I mention this mostly to highlight the superiority of building an array of matches. Using a flag has the disadvantage that each condition must take immediate action making it less flexible. You must repeatedly set a flag, violating DRY and which can easily be forgotten, whereas with the array the data and flag are the same thing.
I am trying to use Getopt::Long add command line arguments to my script (seen below). The problem I am running into is related to multiple commands that do different things. For example I have an option flag that sets the configuration file to use with the script the option is -c [config_path] and I also have -h for help.
The problem I am running into is I need to have a condition that states whether or not the config option has been used AND a config file has been specified. I tried counting the options in #ARGV but found if -h and -c are specifed it causes the script to move on the to the subroutine load_config anyway. Because as seen in the code below when 2 arguments are found in #ARGV it fires the subroutine.
In what way could I fix this? At least in my head specifying -h and -c at the same time sorta contradicts each other. Is there a way to make it so only "informational commands" like help cannot be executed with "operational commands" like -c? Heck is there a way where I get a list of the commands that have been passed? I tried printing the contents of #ARGV but nothing was in it even though I had specified command arguments.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Term::ANSIColor;
use XML::Simple;
use Net::Ping;
use Net::OpenSSH;
use Data::Dumper;
# Create a new hash to copy XML::Simple configuration file data into
my %config_file;
# Clear the screen and diplay version information
system ("clear");
print "Solignis's Backup script v0.8 for ESX\\ESX(i) 4.0+\n";
print "Type -h or --help for options\n\n";
# Create a new XML::Simple object
my $xml_obj = XML::Simple->new();
# Create a new Net::Ping object
my $ping_obj = Net::Ping->new();
my $config_file;
my $argcnt = $#ARGV + 1;
GetOptions('h|help' => \&help,
'c|config=s' => \$config_file
);
if ($argcnt == 0) {
print "You must supply a config to be used\n";
} elsif ($argcnt == 2) {
if (! -e $config_file) {
print color 'red';
print "Configuration file not found!\n";
print color 'reset';
print "\n";
die "Script Halted\n";
} else {
load_config();
}
}
sub load_config {
print color 'green';
print "$config_file loaded\n";
print color 'reset';
my $xml_file = $xml_obj->XMLin("$config_file",
SuppressEmpty => 1);
foreach my $key (keys %$xml_file) {
$config_file{$key} = $xml_file->{$key};
}
print Dumper (\%config_file);
}
sub help {
print "Usage: backup.pl -c [config file]\n";
}
#ARGV is altered by GetOptions, that is why it seems empty. Rather than counting arguments, just directly check if $config_file is defined.
BTW, IMO there is no need to try to exclude -c from being used with -h. Normally a "help" just prints the help text and exits without taking any other action, check that first and it shouldn't matter whether -c is supplied or not.
Something like
my $help;
my $config_file;
GetOptions('h|help' => \$help,
'c|config=s' => \$config_file
);
if ( defined $help ) {
help();
} elsif ( defined $config_file ) {
...;
} else {
die "No arguments!";
}
You might also want to check out Getopt::Euclid which presents some expanded ways to provide options and a cool way of using the programs documentation as the spec for the command-line arguments.
You can always set a default value for the options eg my $help = 0; my $config_file = ""; and then test for those values.
I want something like..
all_objects.pl
my $sub = $ARGV[1];
...
#objs = get_all_objects();
for my $obj (#objs) {
// invoke subroutine $sub with param as $obj.
}
now if I say
all_objects.pl "print 'x '"
all_objects.pl "print '$_ '"
I should get
obj1 obj2 obj3 ...
i.e. the command line arg act as a subroutine in some way. Can this be achieved?
eval "" is bad. Use something like the following, if it fulfills your needs:
my ($sub) = #ARGV;
my %prepared = (
print => sub { print "$_[0]\n" },
woof => sub { $_[0]->woof },
meow => sub { $_[0]->meow },
);
#objs = get_all_objects();
for my $obj (#objs) {
$prepared{$sub}->($obj);
}
Update: For debugging purposes, Perl has a debugger: perldoc perldebug
Eval is evil unless you really know what you're doing (think of it as an unshielded thermonuclear nuke -- sure you could handle one if you had to, and it might even save the world, but you'd be better off leaving it as a last resort, and let the nuclear physicists deal with it.)
You could put your all_objects.pl code into a module, and then use the module on the command line:
put this into AllObjects.pm:
package AllObjects;
use strict;
use warnings;
sub get_all_objects
{
# code here...
}
1;
Now on the command line:
perl -I. -MAllObjects -wle'for my $obj (AllObjects::get_all_objects()) { print "object is $obj" }'
However, it's not really clear what you are trying to achieve with the overall design.
You can read more about perl command-line invokation at perldoc perlrun, and making modules at perldoc perlmod (as well as many posts here on Stack Overflow).
I'm using the File::Find module to traverse a directory tree. Once I find a specific file, I want to stop searching. How can I do that?
find (\$processFile, $mydir);
sub processFile() {
if ($_ =~ /target/) {
# How can I return from find here?
}
}
Seems like you will have to die:
eval {
find (\$processFile, $mydir);
};
if ( $# ) {
if ( $# =~ m/^found it/ ) {
# be happy
}
else ( $# ) {
die $#;
}
}
else {
# be sad
}
sub processFile() {
if ($_ =~ /target/) {
die 'found it';
}
}
In addition to what everyone else said, you may wish to take a look at File-Find-Object, which is both iterative (and as such capable of being interrupted in the middle) and capable of instantiation (so you can initiate and use several at once, or instantiate an F-F-O object based while performing another scan, etc.)
The downside for it is that it isn't core, but it only has Class::Accessor as a dependency, and is pure-Perl so it shouldn't be hard to install.
I should warn you that I am its maintainer, so I may be a bit biased.
Can you throw custom exceptions in Perl?
You could use named blocks and jump to it if you find your result (with next, last, it depends from what you need).
I found this link:
http://www.perlmonks.org/index.pl?node_id=171367
I copied one of the scripts in that list of posts, and this seems to work:
#! /usr/bin/perl -w
use strict;
use File::Find;
my #hits = ();
my $hit_lim = shift || 20;
find(
sub {
if( scalar #hits >= $hit_lim ) {
$File::Find::prune = 1;
return;
}
elsif( -d $_ ) {
return;
}
push #hits, $File::Find::name;
},
shift || '.'
);
$, = "\n";
print #hits, "\n";
It appears that is actually causing find to not traverse any more by using $File::Find::prune.
The function processFile() should return true if it finds the file, and false otherwise. So, every time that processFile calls himself should check this return value. If it is true, some recursive call has found the file, so there's no need to call himself again, and it must also return true. If it's false, the file hasn't been found yet, and it should continue the search.