In spite of having correct values for all the scalar values present in the arguments, This section of code keep getting failed because of the $rc value.I am not sure how the $rc value is getting calculated here.
#args = ("$isql_exe", "-U$user", "-P$password", "-S$server",
"-D$database", "-i$tmp_sql_file", "-o$tmp_err_file");
print $log_file "Truncating stage tables\n";
$rc = 0xffff & system (#args); # <--- what this does?
if ($rc != 0) {
$rc &= 0x00ff;
print $log_file "Error Executing SQL command script $rc $?\n";
$rc = 1;
} ## end if
Please suggest something.
$rc = 0xffff & system (#args); is very wrong.
$ perl -E'say system("non-existent")'
-1
$ perl -E'say 0xFFFF & system("non-existent")'
65535
This code is far better:
system(#args);
my $rc = 0;
if ($? < 0 ) { $rc=1; print $log_file "Error Executing SQL command script: $!\n"; }
elsif ($? & 0x7F) { $rc=1; print $log_file "SQL command script killed by signal ".( $? & 0x7F )."\n"; }
elsif ($? >> 8 ) { $rc=1; print $log_file "SQL command script exited with error ".( $? >> 8 )."\n"; }
It's better because it doesn't use $rc for multiple purposes; it reports error more accurately; and it's much clearer to read.
For a $? of 65280, it will say exited with error 255. Exit codes are specific to the program giving them, and are often meaningless beyond being zero or non-zero. That's why they print error messages.
Related
I've this subroutine whitch start a .bat script but I don't see which line do that.
sub Traitement_Proc {
foreach my $input (#_) {
my $cmd = Fonctions_communes::ResolvEnvDos($input);
my ($proc, $args);
my $chExec;
if ($cmd =~ /^\"/) {
($proc, $args) = $cmd =~ /^\"(.+?)\"(.*)/;
} else {
($proc, $args) = $cmd =~ /^([^\s]+)(.*)/;
}
$chExec = File::Spec->catfile($::G_ParamTable{$::cstExecDir}, $proc);
$chExec = File::Spec->rel2abs($chExec, File::Spec->curdir());
$chExec = "\"".$chExec."\"" . $args;
Fonctions_communes::PrintError(" PROC : "._("Execution of script")." <" . $chExec . ">");
open PROC_OUT, $chExec." 2>&1"." & if ERRORLEVEL 1 exit/b 1"." |";
while(my $output = <PROC_OUT>) {
chomp($output);
Fonctions_communes::PrintError(decode($Fonctions_communes::console_encoding,$output));
}
close(PROC_OUT);
if ($? == 1) {
Fonctions_communes::PrintError(_("The script [_1] ended in failure.",basename($chExec)).".\n");
return 0;
}
}
return 1;
}
inside $input there is the name of bat file whitch passed in argument, there is no $args in my case so the chExec variable is "C:\Users\anes.yahiaoui\Desktop\SPOOC_BD_TU_BD_XX_BD\tieme_RE_PCCA_BD_MAIN\RE_PCCA\BD\avantBDD\Gene_CSV\Proc\IMPORT_INV.bat".
when I call this function (Traitement_proc) my IMPORT_INV will start but I don't see which line do that ?
It's open executing the command. Both open(my $pipe, "shell_cmd |") and open(my $pipe, "-|", "shell_cmd") execute a shell command with the other end of the pipe in $pipe attached to its STDOUT.
For example,
use strict;
use warnings;
use feature qw( say );
use Win32::ShellQuote qw( quote_system_string );
open(my $pipe, quote_system_string(#ARGV)." |")
or die $!;
while (<$pipe>) {
chomp;
say("[$_]");
}
if (!close($pipe)) {
die("Error waiting for child to exit: $!\n") if $!;
die("Child killed by signal ".( $? & 0x7F )."\n") if $? & 0x7F;
die("Child exited with error ".( $? >> 8 )."\n") if $? >> 8;
}
say("Child completed successfully.");
>a.pl perl -le"print for 1..5"
[1]
[2]
[3]
[4]
[5]
Child completed successfully.
I am trying to find the processes which are not running through perl. It works for some processes using following code but not for cgred service.
foreach $critproc (#critarray)
{
#system("/usr/bin/pgrep $critproc");
$var1=`/usr/bin/pgrep $critproc`;
print "$var1";
print "exit status: $?\n:$critproc\n";
if ($? != 0)
{
$probs="$probs $critproc,";
$proccrit=1;
}
}
For cgred I have to specify /usr/bin/pgrep -f cgred to check whether any pid is associated with it or not.
But when I specify -f in above code it gives exit status 0 ($?) to all the processes even if its not running.
Can you anyone tell me how to pass arguments to unix command in Perl.
Thanks
What's $critproc? Where's the -f you say is giving you problems? One might imagine you have some kind of escaping problem, but that shouldn't be the case if $critproc is cgred as you seem to imply.
Given these problem, I'm just going to answer the general question.
The following avoids the shell, so no need to build a shell command:
system("/usr/bin/pgrep", "-f", $critproc);
die "Killed by signal ".( $? & 0x7F ) if $? & 0x7F;
die "Exited with error ".( $? >> 8 ) if ($? >> 8) > 1;
my $found = !($? >> 8);
If you need a shell command, you can use String::ShellQuote's shell_quote to build it.
use String::ShellQuote qw( shell_quote );
my $shell_cmd = shell_quote("/usr/bin/pgrep", "-f", $critproc) . " >/dev/null";
system($shell_cmd);
die "Killed by signal ".( $? & 0x7F ) if $? & 0x7F;
die "Exited with error ".( $? >> 8 ) if ($? >> 8) > 1;
my $found = !($? >> 8);
or
use String::ShellQuote qw( shell_quote );
my $shell_cmd = shell_quote("/usr/bin/pgrep", "-f", $critproc);
my $pid = `$shell_cmd`;
die "Killed by signal ".( $? & 0x7F ) if $? & 0x7F;
die "Exited with error ".( $? >> 8 ) if ($? >> 8) > 1;
my $found = !($? >> 8);
Is it possible to capture output from Perl's require?
For example:
{
local #ARGV = qw/ hello world /;
require 'myscript.pl';
}
Id like to capture any stdout that myscript.pl generates. Can imagine something like this:
{
local #ARGV = qw/ hello world /;
my $output = require 'myscript.pl';
}
Capture::Tiny makes this easier:
use Capture::Tiny 'capture_stdout';
my $output = capture_stdout {
local #ARGV = qw/hello world/;
require 'foo.pl';
};
although I would agree that this is generally not a good way to run a script.
Yes, it's possible. You need to redirect STDOUT before requireing and restore the original STDOUT afterwards.
a.pl
my $capture;
open STDOUTBACKUP, '>&STDOUT';
close STDOUT;
open STDOUT, '>', \$capture;
require 'b.pl';
close STDOUT;
open STDOUT, '>&STDOUTBACKUP';
print "CAPTURED: $capture";
b.pl
print "ModuleB";
Output is CAPTURED: ModuleB
myscript.pl appears to be a Perl script. It makes no sense to use require or do.
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote('myscript.pl', 'hello', 'world');
my $output = `$cmd`;
die("Can't execute myscript.pl: $!\n") if $? == -1;
die("myscript.pl killed by signal ".( $? & 0x7F )."\n") if $? & 0x7F;
die("myscript.pl returned error ".( $? >> 8 )."\n") if $? >> 8;
or
open(my $pipe, '-|', 'myscript.pl', 'hello', 'world')
or die("Can't execute myscript.pl: $!\n");
my $output = '';
$output .= $_ while <$pipe>;
close($pipe);
die("myscript.pl killed by signal ".( $? & 0x7F )."\n") if $? & 0x7F;
die("myscript.pl returned error ".( $? >> 8 )."\n") if $? >> 8;
I have a perl script that runs a command via rsh and I need to get the exit status of that command on the remote server. The shell on both the local and remote servers is csh (I can't change this). To get the exit status on the remote server I am running:
my $output = `rsh myserver $command;echo $status`
The value of $output is the result of the command but the value of $status is never printed out.
I removed the rsh for testing and got the same results. Here is my test script:
#!/usr/local/bin/perl5.8
use strict;
use warnings;
my $output = `printf '';echo \$status`;
print "$command\n";
print "Returned: $output\n";
And here is the output:
printf '';echo $status
Returned:
If I copy and paste the command from the output into the command line the 0 prints out like I would expect:
:>printf '';echo $status
0
Any idea why this works via the command line but not via perl?
The back tick operator in perl uses sh (or more precisely, the default system shell, different from the default login shell) to execute the code, not csh, and $status is not a predefined shell variable in sh.
Problem 1
readpipe (aka `` aka backticks) executes its command using /bin/sh, which uses $? instead of $status.
Solution 1
Adjust the command to use csh
my $status = `/bin/csh -c 'rsh myserver $command; echo $status`;
die "Can't create child: $!\n if $? < 0;
die "Child killed by signal ".($? & 0x7F)."\n" if $? & 0x7F;
die "Child exited with exit code".($? >> 8)."\n" if $? >> 8;
die "rsh exited with exit code $status\n" if $status;
Solution 2
Adjust to a bourne shell:
my $status = `rsh myserver $command; echo $?`;
die "Can't create child: $!\n if $? < 0;
die "Child killed by signal ".($? & 0x7F)."\n" if $? & 0x7F;
die "Child exited with exit code".($? >> 8)."\n" if $? >> 8;
die "rsh exited with exit code $status\n" if $status;
Solution 3
The shell actually returns the exit code of the last command it executes, so you don't need to create a new channel to grab it.
my $output = `rsh myserver $command`;
die "Can't create child: $!\n if $? < 0;
die "Child killed by signal ".($? & 0x7F)."\n" if $? & 0x7F;
die "Child exited with exit code".($? >> 8)."\n" if $? >> 8;
print($output);
It also means you are now free to capture the remote program's output without interference.
Problem 2
The contents of $command are going to be interpolated by both the local shell and the remote shell. For example, if $command contains echo *, it will list the local files instead of the remote ones. Some escaping is needed.
Solution
use String::ShellQuote qw( shell_quote );
my $local_command = shell_quote('rsh', 'myserver', $command);
my $output = `$local_command`;
die "Can't create child: $!\n if $? < 0;
die "Child killed by signal ".($? & 0x7F)."\n" if $? & 0x7F;
die "Child exited with exit code".($? >> 8)."\n" if $? >> 8;
print($output);
I created a script in perl to run programs with a timeout. If the program being executed takes longer then the timeout than the script kills this program and returns the message "TIMEOUT".
The script worked quite well until I decided to redirect the output of the executed program.
When the stdout and stderr are being redirected, the program executed by the script is not being killed because it has a pid different than the one I got from fork.
It seems perl executes a shell that executes my program in the case of redirection.
I would like to have the output redirection but still be able to kill the program in the case of a timeout.
Any ideas on how I could do that?
A simplified code of my script is:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX ":sys_wait_h";
my $timeout = 5;
my $cmd = "very_long_program 1>&2 > out.txt";
my $pid = fork();
if( $pid == 0 )
{
exec($cmd) or print STDERR "Couldn't exec '$cmd': $!";
exit(2);
}
my $time = 0;
my $kid = waitpid($pid, WNOHANG);
while ( $kid == 0 )
{
sleep(1);
$time ++;
$kid = waitpid($pid, WNOHANG);
print "Waited $time sec, result $kid\n";
if ($timeout > 0 && $time > $timeout)
{
print "TIMEOUT!\n";
#Kill process
kill 9, $pid;
exit(3);
}
}
if ( $kid == -1)
{
print "Process did not exist\n";
exit(4);
}
print "Process exited with return code $?\n";
exit($?);
Thanks for any help.
Try changing $cmd from
my $cmd = "very_long_program 1>&2 > out.txt";
to
my $cmd = "exec very_long_program 1>&2 > out.txt";
The exec will tell the shell that gets spawned by perl to replace itself with very_long_program, rather than running very_long_program as a child.
(The reason perl spawns a shell in this case is because $cmd contains the redirect characters - and perl doesn't know how to handle them itself. An alternative way of solving the problem is to do the redirection in perl itself after the fork() but prior to calling exec() - but that's slightly trickier, so try the exec workaround first!)
An alternative is to redirect STDOUT and STDERR after the fork and run the command without the redirection:
open(STDOUT, ">", "out.txt") or die "Err: $!";
open(STDERR, ">&STDOUT");
exec("very_long_command");
die "Failed to exec very_long_command: $!";