I am writing a function in perl which will kill a process given its PID.
sub ShutPidForWindows()
{
require Win32::Process;
$PID = 1234;
$count = 0;
$ReturnStatus = 0;
$ExitCode = 0 ;
if ($PID == 0)
{
return ($ReturnStatus);
}
Win32::Process::KillProcess($PID, $ExitCode);
print "PID = ".$PID."\n";
print "Return Code = ".$ExitCode."\n";
if ($ExitCode)
{
$ReturnStatus = 1;
}
else
{
$ReturnStatus = 2;
}
return ($ReturnStatus);
}
when this function is executed it always returns 2. Even though the process 1234 does not exists.
The o/p I get is:
PID = 1234
Return Code = 0
Perl Doc says that ExitCode will be populated by the exit code returned by the process. Then ExitCode should be 1.
Am I doing anything wrong?
The problem is that you are using require instead of use to load the module. Sometimes this is OK, but you should always follow the examples in the module's documentation.
You must also always use strict and use warnings at the top of every Perl program you write. This will make it necessary to declare all of your variables, which should be done as close as possible to their first point of use. These measures will reveal many errors that you may otherwise overlook, and is especially important when you are asking others for help with your code.
If you examine $^E after the call to Win32::Process::KillProcess, you might see a value like
The parameter is incorrect
which should tell you that you did something wrong.
Related
When I fork a new process inside the if condition, surprisingly both if and else block gets executed.
According to the perl fork subroutine documentation when we execute the method, it returns either undef, PID depending on whether the fork failed, succeeded respectively.
Below is the code where both the blocks are getting executed.
if(my $a = fork ) {
say "if block";
} else {
say "else block";
}
output:
if block
else block
Where as if I return those manually only one block gets executed depending on whether i return 0 or 1.
sub a { 1; }
if(my $a = a ) {
say "if block";
} else {
say "else block";
}
output:
if block
Any idea why this is happening?
According to the perl fork subroutine documentation when we execute the method, it returns either undef, PID depending on whether the fork failed, succeeded respectively.
Not quite. It actually says the following:
It returns the child pid to the parent process, 0 to the child process, or undef if the fork is unsuccessful.
So,
In the parent process, fork returns the child's PID, so the parent process outputs if block.
In the child process, fork returns 0, so the child process outputs else block.
By checking the value returned, you can have the parent and child do different things.
It's easier to see what's happening if you also output the process ID (the $$ special variable) with each say statement:
use v5.10;
if( fork ) {
say "$$ (parent): if block";
} else {
say "$$ (child): else block";
}
You'd then see that you get outputs from two different processes:
19997 (parent): if block
20024 (child): else block
Typically, the parent process continues and does its thing while the child process continues and does whatever work you wanted to offload. However, the child inherits the standard filehandles of the parent, so the output goes to the same place. If you don't want that, you can immediately change standard output (and others) in the child (or parent, I guess):
use v5.10;
if( fork ) {
say "$$ (parent): if block";
} else {
say "$$ (child): else block";
open STDOUT, ...
}
If you wanted the current process to turn into something else (so that you still only had one process), look at exec.
I have a few blocks of code, inside a function of some object, that can run in parallel and speed things up for me.
I tried using subs::parallel in the following way (all of this is in a body of a function):
my $is_a_done = parallelize {
# block a, do some work
return 1;
};
my $is_b_done = parallelize {
# block b, do some work
return 1;
};
my $is_c_done = parallelize {
# block c depends on a so let's wait (block)
if ($is_a_done) {
# do some work
};
return 1;
};
my $is_d_done = parallelize {
# block d, do some work
return 1;
};
if ($is_a_done && $is_b_done && $is_c_done && $is_d_done) {
# just wait for all to finish before the function returns
}
First, notice I use if to wait for threads to block and wait for previous thread to finish when it's needed (a better idea? the if is quite ugly...).
Second, I get an error:
Thread already joined at /usr/local/share/perl/5.10.1/subs/parallel.pm line 259.
Perl exited with active threads:
1 running and unjoined
-1 finished and unjoined
3 running and detached
I haven't seen subs::parallel before, but given that it's doing all of the thread handling for you, and it seems to be doing it wrong, based on the error message, I think it's a bit suspect.
Normally I wouldn't just suggest throwing it out like that, but what you're doing really isn't any harder with the plain threads interface, so why not give that a shot, and simplify the problem a bit? At the same time, I'll give you an answer to the other part of your question.
use threads;
my #jobs;
push #jobs, threads->create(sub {
# do some work
});
push #jobs, threads->create(sub {
# do some other work
});
# Repeat as necessary :)
$_->join for #jobs; # Wait for everything to finish.
You need something a little bit more intricate if you're using the return values from those subs (simply switching to a hash would help a good deal) but in the code sample you provided, you're ignoring them, which makes things easy.
sub DirectoryExists {
my $param = shift;
# Remove first element of the array
shift #{$param};
# Loop through each directory to see if it exists
foreach my $directory (#{$param}) {
unless (-e $directory && -d $directory) {
return 0;
}
}
# True
return 1;
}
Is there any way to optimize this code?
Is there any good way to optimize this code?
That algorithm is pretty efficient, because it stops at the first item but you might want to give List::Util::first a try.
use List::Util qw<first>;
#...
return defined first { -e && -d } #$param;
The only major optimization would be that it runs in the C-layer. It's also a pretty recognizable idiom in Perl, and so despite the golf look, the purpose is to "speak perl", not to golf.
List::MoreUtils::any would give you a similar effect and as well, it's a better fit to what you're trying to express: you're asking if any in the array are directories. (a hint though, stack parameter passing is slightly to significantly faster than constructing a reference and passing it--at least in my tests.)
Anyway, here's what it looks like:
return any { -e && -d } #$param;
Means to return true if any satisfy that expression. any often runs in the C-layer, if the module could load its XS version. Otherwise it's "Pure Perl" and probably runs similar to yours.
However, I'm pretty sure you don't have to test for both existence and directory. I'm pretty sure that if the file does not exist, it's not going to be seen as a directory. So, you could collapse it to one condition.
I would write that code as:
sub all_directories_exist {
my $param = shift;
# Remove first element of the array
shift #{$param};
for my $dir ( #{ $param } ) {
return unless -e $directory;
return unless -d _;
}
return 1;
}
I am guessing —although I haven't benchmarked it— one cannot get much faster than that.
Two points:
Do NOT return 0 to indicate failure. You will be surprised if your sub is called in list context.
Are you sure you want to modify the array pointed to by $param?
I have a Perl routine that manages error checking. There are about 10 different checks and some are nested, based on prior success. These are typically not exceptional cases where I would need to croak/die. Also, once an error occurs, there's no point in running through the rest of the checks.
However, I can't seem to think of a neat way to solve this issue except by using something analogous to the following horrid hack:
sub lots_of_checks
{
if(failcond)
{
goto failstate:
}
elsif(failcond2)
{
goto failstate;
}
#This continues on and on until...
return 1; #O happy day!
failstate:
return 0; #Dead...
}
What I would prefer to be able to do would be something like so:
do
{
if(failcond)
{
last;
}
#...
};
An empty return statement is a better way of returning false from a Perl sub than returning 0. The latter value will actually be true in list context:
sub lots_of_checks {
return if fail_condition_1;
return if fail_condition_2;
# ...
return 1;
}
Perhaps you want to have a look at the following articles about exception handling in perl5:
perl.com: Object Oriented Exception Handling in Perl
perlfoundation.com: Exception Handling in Perl
You absolutely can do what you prefer.
Check: {
last Check
if failcond1;
last Check
if failcond2;
success();
}
Why would you not use exceptions? Any case where the normal flow of the code should not be followed is an exception. Using "return" or "goto" is really the same thing, just more "not what you want".
(What you really want are continuations, which "return", "goto", "last", and "throw" are all special cases of. While Perl does not have full continuations, we do have escape continuations; see http://metacpan.org/pod/Continuation::Escape)
In your code example, you write:
do
{
if(failcond)
{
last;
}
#...
};
This is probably the same as:
eval {
if(failcond){
die 'failcond';
}
}
If you want to be tricky and ignore other exceptions:
my $magic = [];
eval {
if(failcond){
die $magic;
}
}
if ($# != $magic) {
die; # rethrow
}
Or, you can use the Continuation::Escape module mentioned above. But
there is no reason to ignore exceptions; it is perfectly acceptable
to use them this way.
Given your example, I'd write it this way:
sub lots_of_checks {
local $_ = shift; # You can use 'my' here in 5.10+
return if /condition1/;
return if /condition2/;
# etc.
return 1;
}
Note the bare return instead of return 0. This is usually better because it respects context; the value will be undef in scalar context and () (the empty list) in list context.
If you want to hold to a single-exit point (which is slightly un-Perlish), you can do it without resorting to goto. As the documentation for last states:
... a block by itself is semantically identical to a loop that executes once.
Thus "last" can be used to effect an early exit out of such a block.
sub lots_of_checks {
local $_ = shift;
my $all_clear;
{
last if /condition1/;
last if /condition2/;
# ...
$all_clear = 1; # only set if all checks pass
}
return unless $all_clear;
return 1;
}
If you want to keep your single in/single out structure, you can modify the other suggestions slightly to get:
sub lots_of_checks
{
goto failstate if failcond1;
goto failstate if failcond2;
# This continues on and on until...
return 1; # O happy day!
failstate:
# Any clean up code here.
return; # Dead...
}
IMO, Perl's use of the statement modifier form "return if EXPR" makes guard clauses more readable than they are in C. When you first see the line, you know that you have a guard clause. This feature is often denigrated, but in this case I am quite fond of it.
Using the goto with the statement modifier retains the clarity, and reduces clutter, while it preserves your single exit code style. I've used this form when I had complex clean up to do after failing validation for a routine.
I have a Perl project were I just had a problem by making a circular package call. The code below demonstrates the problem.
When this is executed, each package will call the other until all of the memory of the computer is consumed and it locks up. I agree that this is a bad design and that circular calls like this should not be made in the design, but my project is sufficiently big that I would like to detect this at run time.
I have read about the weaken function and Data::Structure::Util, but I have not figured out a way to detect if there is a circular package load (I am assume, because a new copy is being made at each iteration and stored in each copy of the $this hash). Any ideas?
use system::one;
my $one = new system::one();
package system::one;
use strict;
use system::two;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{two} = new system::two();
return $this;
}
package system::two;
use strict;
use system::one;
sub new {
my ($class) = #_;
my $this = {};
bless($this,$class);
# attributes
$this->{one} = new system::one();
return $this;
}
Here, have some code too. :)
sub break_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
croak "found $count levels of recursion into $call"
if $caller[3] eq $call && ++$count > $allowed;
}
}
sub check_recursion(;$) {
my $allowed = #_ ? shift : 1;
my #caller = caller(1);
my $call = $caller[3];
my $count = 1;
for(my $ix = 2; #caller = caller($ix); $ix++) {
return 1
if $caller[3] eq $call && ++$count > $allowed;
}
return 0;
}
These are called like:
break_recursion(); # to die on any recursion
break_recursion(5); # to allow up to 5 levels of recursion
my $recursing = check_recursion(); # to check for any recursion
my $recursing = check_recursion(10); # to check to see if we have more than 10 levels of recursion.
Might CPAN these, I think. If anyone has any thoughts about that, please share.
The fact that these are in separate packages has nothing at all to do with the fact that this runs infinitely, consuming all available resources. You're calling two methods from within one another. This isn't circular reference, it's recursion, which is not the same thing. In particular, weaken won't help you at all. You'd get exactly the same effect from:
sub a {
b();
}
sub b {
a();
}
a();
The best way to avoid this is don't do that. More usefully, if you have to write recursive functions try not to use multiple functions in the recursion chain, but simply the one, so you have an easier time mentally keeping track of where your calls should terminate.
As to how to detect whether something like this is happening, you would have to do something simple like increment a variable with your recursion depth and terminate (or return) if your depth exceeds a certain value. But you really shouldn't have to rely on that, it's similar to writing a while loop and using an increment there to make sure your function doesn't run out of control. Just don't recurse over a set unless you know how and when it terminates.
Another relevant question would be what are you trying to accomplish in the first place?
I suggest making a routine called something like break_constructor_recursion() that uses caller() to examine the call stack like so:
Find out what method in what package just called me.
Look up the rest of the call stack seeing if that same method in that same package is anywhere further up.
If so, die() with something appropriate.
Then you add a call to break_constructor_recursion() in your constructors. If the constructor is being called from inside itself, it'll bomb out.
Now, this can throw false positives; it's not impossible for a constructor to be legitimately called inside itself. If you have issues with that, I'd say just have it look for some N additional occurrences of the constructor before it identifies an error. If there are 20 calls to system::two::new() on the stack, the chances that you aren't recursing are pretty low.
The classic break on double recursion is to use a state variable to determine if you are already inside a function:
{
my $in_a;
sub a {
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
}
You can do whatever you want if $in_a is true, but dieing or returning is common. If you are using Perl 5.10 or later you can use the state function instead of nesting the function in its own scope:
sub a {
state $in_a;
return if $in_a; #do nothing if b(), or someone b() calls, calls a()
$in_a = 1;
b();
$in_a = 0;
}
use warnings;
without warnings:
#!/usr/bin/perl
use strict;
sub foo {
foo();
}
foo();
-
$ perl script.pl
^C # after death
with warnings:
#!/usr/bin/perl
use strict;
use warnings;
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
^C # after death
Always always use warnings.
use warnings FATAL => qw( recursion );
#!/usr/bin/perl
use strict;
use warnings FATAL => qw( recursion );
sub foo {
foo();
}
foo();
-
$ perl script.pl
Deep recursion on subroutine "main::foo" at script.pl line 7.
$