I'm a beginner in Perl and I have some trouble using the "system" call. Here is a little piece of code where I try to execute 2 shell commands :
# First command is :
# dot -Tpng $dottmpfile > $pngfile
# Second command is :
# rm $dottmpfile
if (!($pngfile eq "")) {
my #args = ("dot", "-Tpng", $dottmpfile, " > ", $pngfile);
system (join (' ' , #args ))
or die "system #args failed : $!";
unlink $dottmpfile;
}
EDIT : Here is my code now, and I still get an error :
system dot -Tpng toto.dot > toto.png failed : Inappropriate ioctl for device at /home/claferri/bin/fractal.pl line 79.
I've used system to produce this piece of code.
Looking at perldoc -f system, note:
If there is more than one argument in LIST, or if LIST is an array with more than one value, starts the program given by the first element of the list with arguments given by the rest of the list. If there is only one scalar argument, the argument is checked for shell metacharacters, and if there are any, the entire argument is passed to the system's command shell for parsing
You are invoking system LIST so the > ends up being passed to dot instead of being interpreted by the shell.
I would recommend that you keep using system LIST because it is a little safer than passing everything through the shell. According to the docs, you can specify the output file by using the -o option to dot, so do that.
If you really want to dot your is and cross your ts (pun not intended), then you can use:
if ( defined $pngfile and $pngfile ne '') {
my #args = (dot => '-Tpng', $dottmpfile, "-o$pngfile");
if ( system #args ) {
warn "'system #args' failed\n";
my $reason = $?;
if ( $reason == -1 ) {
die "Failed to execute: $!";
}
elsif ( $reason & 0x7f ) {
die sprintf(
'child died with signal %d, %s coredump',
($reason & 0x7f),
($reason & 0x80) ? 'with' : 'without'
);
}
else {
die sprintf('child exited with value %d', $reason >> 8);
}
}
warn "'system #args' executed successfully\n";
unlink $dottmpfile;
}
You are using > to tell the shell to redirect output to a file yet by using invoking system LIST, you are bypassing the shell. Therefore, you can use:
system ( join (' ' , #args ) );
or
system "#args";
system returns 0 on success and non-zero on "failure". It's contrary to the way most of these idioms look and a little counter-intuitive, but with system calls you should use an expression like:
system($command) and warn "system $command: failed $?\n"; # and not or
or
if (system($command) != 0) { ... handle error ... }
Is the "dot" executable in the PATH? Does it have executable permissions? Which specific error are you getting with this code?
It seems that is correct according to perldoc -f system.
Related
I am new to Perl and trying to write a code to keep executing an action until the match is found and else give an error.
I am trying to execute a command ps -ef and check if it has got any process running in the name of "box", if there is no process named "box" found, I want to repeat ps -ef command execution until it gets the "box" process and then proceed to next action.
#!/usr/bin/perl -w
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
while (<FH>) {
if (/$line/i) { next; }
else {
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
You need to use an infinite loop and an exit-condition. Your condition is that the ps -ef command contains the word box. There is no need to open a pipe to that command explicitly, you can just run it as a system call with the qx operator (same as backticks).
use strict;
use warnings;
my $ps;
PS: while (1) {
$ps = qx/ps -ef/;
last PS if $ps =~ m/box/i;
print '.'; # do something in every run
}
print $ps;
As this has come up in the comments as well as in in AdrianHHH's answer: it might make sense to sleep after every run to make sure you don't hog the CPU. Depending on the nature of the process you are looking for, either the sleep builtin or usleep from Time::HiRes might be appropriate. The latter let's your program rest for milliseconds, while the builtin only works with full seconds. These might be too long if the target box process is very quick.
Explanation of your code:
Note that you have some issues in your implementation. I'll explain what your code does. This is taken from the question, comments are mine.
#!/usr/bin/perl -w
# open a filehandle to the ps command
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
# read the output of one run line by line, for each line execute
# the block
while (<FH>) {
# if there is 'box' case-insensitive, skip the line
if (/$line/i) { next; }
else {
# else output (not run!) the command
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
After it went through all the lines of the output of your command once it will stop.
I would recommend using pgrep(1) instead of ps because it lets you do a more granular search. With ps -ef, you potentially have to deal with cases like:
boxford 6254 6211 0 08:23 pts/1 00:00:00 /home/boxford/box --bounding-box=123
It's hard to tell if you're matching a process being run by a user with box in their username, a process that has box somewhere in its path, a process named box, or a process with box somewhere in its argument list.
pgrep, on the other hand, lets you match against just the process name or the full path, a specific user or users, and more. The following prints a message when a process named box appears (this looks for an exact match, so it will not match processes named dropbox, for example):
use strict;
use warnings;
use 5.010;
use String::ShellQuote qw(shell_quote);
sub is_running {
my ($proc) = #_;
my $cmd = 'pgrep -x ' . shell_quote($proc) . ' >/dev/null 2>&1';
system($cmd);
if ($? == -1) {
die "failed to execute pgrep: $!";
}
elsif ($? & 127) {
die "pgrep died with signal ", $? & 127;
}
else {
my $status = $? >> 8;
die "pgrep exited with error: exit status $status" if $status > 1;
return $status == 0;
}
}
my $proc = 'box';
until ( is_running($proc) ) {
sleep 1;
}
say "Process '$proc' is running";
Note that pgrep doesn't have a case-insensitive flag, probably because process names in *nix are almost always lowercase. If you really need to do a case-insensitive match, you can pass [Bb][Oo][Xx] to the is_running function.
The ps command outputs the current list of processes, then it completes. The code in the question reads that output. Suppose that the first ps command that is executed does not contain the wanted line, then there is nothing in the code in the question to run the ps command again.
The next statement in the question makes the script move on to the next line in the output from ps, not to rerun the command. The else print ... after the next will probably be executed for the first line of the output from ps. The outcome is that the print is run for each line in the ps output that does not have the wanted text and that the next command has no significant effect. In the code print ... or die "..." the or die "..." part is not very useful, the print is unlikely to fail and even if it did the die message would be wrong.
Perhaps you should write some code in the following style. Here the ps is run repeatedly until the wanted text is found. Note the sleep call, without that the script will keep running without pause, possibly preventing real work or at least slowing it down.
# This code is not tested.
use strict;
use warnings;
my $found_wanted_line = 0; # Boolean, set to false
my $line = "box";
while ( ! $found_wanted_line ) {
open (my $FH, "ps -ef |") or die "Cannot run the command:$!\n";
while (<$FH>) {
if (/$line/i) {
$found_wanted_line = 1; # Boolean, set to true
last;
}
}
close ($FH);
if ( ! $found_wanted_line )
sleep 2; # Pause for 2 seconds, to prevent this script hogging the CPU.
}
}
Hi below is my perl code :
#!/usr/bin/perl -w
no warnings;
use Env;
my $p4user = $ENV{'P4USER'};
my $current_path = $ENV{'PWD'};
print("\t Hello $p4user. You are currently in $current_path path.\n");
open($user_in,"$ARGV[0]") || die("failed to open the argument file $ARGV[0]\n");
print("\t To create a new client enter '1' |");
print("\t To use an existing client enter '2' : ... ");
my $cl_op = <>;
chop($cl_op);
if (($cl_op == 1) || ($cl_op == 2))
{
# do something common for both condition
if ($cl_op == 1)
{
# do something
}
elsif ($cl_op == 2)
{
# do something
}
}
else
{
die("\n\t Sorry. Invalid option : $cl_op\n");
}
Then the script runs like :
Hello biren. You are currently in /remote/vgvips18/biren/tcf_4nov path.
Sorry. Invalid option : ###################################################################
To create a new client enter '1' | To use an existing client enter '2' : ...
Any Idea why the script is behaving like this. When I comment out this line "
open($user_in,"$ARGV[0]") || die("failed to open the argument file
$ARGV[0]\n");
", the script runs fine.
Can anyone help why the script behaves when i pass a file as an argument on command line.
my $cl_op = <>;
That will read the first line of the file you passed as the arg.
To make it read the user response to your prompt, change it to this:
my $cl_op = <STDIN>;
It's wise to include sanity checks to verify that a file name was passed as an argument before attempting to open it.
my $user_in;
if ( defined $ARGV[0] ) {
die "$ARGV[0] does not exist.\n" unless -e $ARGV[0];
open($user_in,"$ARGV[0]")
or die("failed to open the argument file $ARGV[0]: $!\n");
}
<> is shorthand for <ARGV>, where ARGV is a special (i.e., magic) filehandle that can either mean filenames from your command-line arguments, or STDIN if there are no command-line arguments. Perl will make the decision how to treat ARGV based on the contents of #ARGV the first time it is used.
If you want invocations of your program like
perl my_script.pl userfile inputfile
perl my_script.pl userfile < inputfile
cat inputfile | perl my_script.pl userfile
to all work alike, you will want to consume the first element of #ARGV before you refer to ARGV. Like so:
my $userfile = shift #ARGV; # removes $ARGV[0] from front of #ARGV
open $user_in, '<', $userfile or ...
...
my $cl_op = <>;
Now $cl_op is being read from the second filename you provide, or from STDIN.
I need to run a shell command with system() in Perl. For example,
system('ls')
The system call will print to STDOUT, but I want to capture the output into a variable so that I can do future processing with my Perl code.
That's what backticks are for. From perldoc perlfaq8:
Why can't I get the output of a command with system()?
You're confusing the purpose of system() and backticks (``). system()
runs a command and returns exit status information (as a 16 bit value:
the low 7 bits are the signal the process died from, if any, and the
high 8 bits are the actual exit value). Backticks (``) run a command
and return what it sent to STDOUT.
my $exit_status = system("mail-users");
my $output_string = `ls`;
See perldoc perlop for more details.
IPC::Run is my favourite module for this kind of task. Very powerful and flexible, and also trivially simple for small cases.
use IPC::Run 'run';
run [ "command", "arguments", "here" ], ">", \my $stdout;
# Now $stdout contains output
Simply use similar to the Bash example:
$variable=`some_command some args`;
That's all. Notice, you will not see any printings to STDOUT on the output because this is redirected to a variable.
This example is unusable for a command that interact with the user, except when you have prepared answers. For that, you can use something like this using a stack of shell commands:
$variable=`cat answers.txt|some_command some args`;
Inside the answers.txt file you should prepare all answers for some_command to work properly.
I know this isn't the best way for programming :) But this is the simplest way how to achieve the goal, specially for Bash programmers.
Of course, if the output is bigger (ls with subdirectory), you shouldn't get all output at once. Read the command by the same way as you read a regular file:
open CMD,'-|','your_command some args' or die $#;
my $line;
while (defined($line=<CMD>)) {
print $line; # Or push #table,$line or do whatever what you want processing line by line
}
close CMD;
An additional extended solution for processing a long command output without extra Bash calling:
my #CommandCall=qw(find / -type d); # Some example single command
my $commandSTDOUT; # File handler
my $pid=open($commandSTDOUT),'-|'); # There will be an implicit fork!
if ($pid) {
#parent side
my $singleLine;
while(defined($singleline=<$commandSTDOUT>)) {
chomp $line; # Typically we don't need EOL
do_some_processing_with($line);
};
close $commandSTDOUT; # In this place $? will be set for capture
$exitcode=$? >> 8;
do_something_with_exit_code($exitcode);
} else {
# Child side, there you really calls a command
open STDERR, '>>&', 'STDOUT'; # Redirect stderr to stdout if needed. It works only for child - remember about fork
exec(#CommandCall); # At this point the child code is overloaded by an external command with parameters
die "Cannot call #CommandCall"; # Error procedure if the call will fail
}
If you use a procedure like that, you will capture all procedure output, and you can do everything processing line by line. Good luck :)
I wanted to run system() instead of backticks because I wanted to see the output of rsync --progress. However, I also wanted to capture the output in case something goes wrong depending on the return value. (This is for a backup script). This is what I am using now:
use File::Temp qw(tempfile);
use Term::ANSIColor qw(colored colorstrip);
sub mysystem {
my $cmd = shift; # "rsync -avz --progress -h $fullfile $copyfile";
my ($fh, $filename) = tempfile();
# http://stackoverflow.com/a/6872163/2923406
# I want to have rsync progress output on the terminal AND capture it in case of error.
# Need to use pipefail because 'tee' would be the last cmd otherwise and hence $? would be wrong.
my #cmd = ("bash", "-c", "set -o pipefail && $cmd 2>&1 | tee $filename");
my $ret = system(#cmd);
my $outerr = join('', <$fh>);
if ($ret != 0) {
logit(colored("ERROR: Could not execute command: $cmd", "red"));
logit(colored("ERROR: stdout+stderr = $outerr", "red"));
logit(colored("ERROR: \$? = $?, \$! = $!", "red"));
}
close $fh;
unlink($filename);
return $ret;
}
# And logit() is something like:
sub logit {
my $s = shift;
my ($logsec, $logmin, $loghour, $logmday, $logmon, $logyear, $logwday, $logyday, $logisdst) = localtime(time);
$logyear += 1900;
my $logtimestamp = sprintf("%4d-%02d-%02d %02d:%02d:%02d", $logyear, $logmon+1, $logmday, $loghour, $logmin, $logsec);
my $msg = "$logtimestamp $s\n";
print $msg;
open LOG, ">>$LOGFILE";
print LOG colorstrip($msg);
close LOG;
}
I'm having an issue with a Perl script relating to the Weather Research Forecast (WRF) model configuration. The script in question is a part of the download located here (login required, simple signup). If you download the most recent WRF-NMM core, in the unzipped directory is arch/Config_new.pl. The error that I'm having lies somewhere within lines 262-303:
until ( $validresponse ) {
print "------------------------------------------------------------------------\n" ;
print "Please select from among the following supported platforms.\n\n" ;
$opt = 1 ;
open CONFIGURE_DEFAULTS, "< ./arch/configure_new.defaults"
or die "Cannot open ./arch/configure_new.defaults for reading" ;
while ( <CONFIGURE_DEFAULTS> )
{
for $paropt ( #platforms )
{
if ( substr( $_, 0, 5 ) eq "#ARCH"
&& ( index( $_, $sw_os ) >= 0 ) && ( index( $_, $sw_mach ) >= 0 )
&& ( index($_, $paropt) >= 0 ) )
{
$optstr[$opt] = substr($_,6) ;
$optstr[$opt] =~ s/^[ ]*// ;
$optstr[$opt] =~ s/#.*$//g ;
chomp($optstr[$opt]) ;
$optstr[$opt] = $optstr[$opt]." (".$paropt.")" ;
if ( substr( $optstr[$opt], 0,4 ) ne "NULL" )
{
print " %2d. %s\n",$opt,$optstr[$opt] ;
$opt++ ;
}
}
}
}
close CONFIGURE_DEFAULTS ;
$opt -- ;
print "\nEnter selection [%d-%d] : ",1,$opt ;
$response = <STDIN> ;
if ( $response == -1 ) { exit ; }
if ( $response >= 1 && $response <= $opt )
{ $validresponse = 1 ; }
else
{ print("\nInvalid response (%d)\n",$response);}
}
Specifically, I am sent to an input line without any kind of prompting or list of what my options are. Only after I select a valid choice am I presented with the previous options. This is repeated a second time with another chunk of code further down (lines 478-528). What's got me confused is that, when I entered debugging mode, I inserted a break before the start of this portion of code. I ran p $validresponse and got the following:
0
If you REALLY want Grib2 output from WRF, modify the arch/Config_new.pl script.
Right now you are not getting the Jasper lib, from the environment, compiled into WRF.
This intrigues me, as the paragraph is from a printf from several lines before. In this particular script, it is the only printf that has run so far, but why the output was saved to the next created variable is beyond me. Any suggestions?
EDIT: After looking at choroba's suggestion, the same problem occurs with any type of redirection, whether piping, using tee, or stderr/stdout redirection. As such, I'm thinking it may be a problem with bash? That is, the only way I can run it is without any kind of logging (at least to my knowledge, which is admittedly quite limited).
You want to enable autoflushing, so that the Perl print buffer is flushed automatically after something is printed.
This is the default behavior when a Perl script outputs to a terminal window, but when the output is redirected in any way, the default is to buffer the output. Enabling autoflushing disables the buffering.
You can enable autoflushing by adding the following two lines to the top of the Perl script (below the Perl hashbang line, of course):
use IO::Handle qw();
STDOUT->autoflush(1);
When you redirect with pipes or similar you are (normally) redirecting STDOUT. All of the print statements go to STDOUT, so when redirecting the will be sent to whatever process you are piping to. Without seeing the full command you are using I can't say exactly why you aren't seeing the STDOUT messages, but they are obviously being swallowed by the redirection. Whether or not that is actually a problem if for you to decide.
the line
$response = <STDIN> ;
causes the script to wait for input from STDIN which is why you see the prompt. You are not piping anything in to STDIN so it waits.
I'm a beginner in Perl. I have a Windows batch script which contains multiple NMake commands. An existing issue with this batch script is that even if the NMake command fails during its execution, ERRORLEVEL doesn't get set properly.
So we never know whether the command worked until we parse the log file. I looked into it but couldn't find a solution. I, then thought of converting this batch script to a Perl script assuming that trapping error will be easier but it seems it's not that easy :)
Whenever I run my Perl script, the 'system' command always returns 0. I looked at many different links, and realized that capturing the correct return status of 'system' command is not that straightforward. Still, I tried the suggestions but things are not working. :(
Let me mention that the NMake command that is called, in turn, calls many different commands during its execution. For instance, the command output mentioned below, which is throwing 'fatal error', is actually part of a Perl script (check_dir.pl). This call to Perl script is written in the NMake file itself.
If I call this Perl file (check_dir.pl) directly and check for exit value, I get correct result i.e., the command fails and prints a non-zero exit value (...unexpectedly returned exit value 2).
Tried Perl's system function but it didn't help. I used the following code:
system ("nmake /f _nt.mak pack_cd SUB_PLAT=$PLAT DR=$plat 2>&1");
if ( $? == -1 ) {
print "Command failed to execute: $!\n";
}
elsif ( $? & 127 ) {
printf "The child died with signal %d, %s a coredump\n",
( $? & 127 ), ( $? & 128 ) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $? >> 8;
}
Output:
.....
.....
Unable to open dir: R:\TSM_Latest
Compressing...NMAKE : fatal error U1077: 'if' : return code '0x2'
Stop.
child exited with value 0
Also tried:
use IPC::System::Simple qw(system);
my $exit_status = system ("nmake /f _nt.mak pack_cd SUB_PLAT=$PLAT DR=$plat 2>&1");
if ($exit_status != 0) {
print "Failure";
exit 3;
} else {
print "Success";
}
Finally tried the following module:
use IPC::Run qw( run timeout );
run "nmake /f _nt.mak pack_cd SUB_PLAT=$PLAT DR=$plat 2>&1" or die "NMake returned $?";
Nothing seems to be working :(
Please correct me if i'm interpreting the return value of system incorrectly.
You have:
use IPC::System::Simple qw(system);
my $exit_status = system ("nmake /f _nt.mak pack_cd SUB_PLAT=$PLAT DR=$plat 2>&1");
Given that you don't seem to care about the actual output, you can try
my $exit_status = systemx(nmake =>
qw(/f _nt.mak pack_cd),
"SUB_PLAT=$PLAT",
"DR=$plat",
);
To make sure you bypass cmd.exe and see if you get something useful.
For reference, the exit codes from nmake are listed here.
Running the following program:
use strict; use warnings;
use IPC::System::Simple qw(systemx);
use Try::Tiny;
my $status = 0;
try { systemx nmake => qw(/f bogus) }
catch { ($status) = ( /exit value ([0-9])/ ) };
print "Failed to execute nmake. Exit status = $status\n";
produces:
NMAKE : fatal error U1052: file 'bogus' not found
Stop.
Failed to execute nmake. Exit status = 2
The following version:
use strict; use warnings;
my $status = system nmake => qw(/f bogus);
if ($status) {
if ($? == -1) {
print "failed to execute: $!\n";
}
elsif ($? & 127) {
printf "child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $? >> 8;
}
}
produces:
NMAKE : fatal error U1052: file 'bogus' not found
Stop.
child exited with value 2
In fact, even when I use
my $status = system "nmake /f bogus";
I get the same correct and expected output.
Ditto when I use
my $status = system "nmake /f bogus 2>&1";
These observations lead me to the following questions:
Which version of nmake are you using?
Is the /I option in effect? Even though you don't set it from the command line, note the following:
/I Ignores exit codes from all commands. To set or clear /I for part of a makefile, use !CMDSWITCHES. To ignore exit codes for part of a makefile, use a dash (–) command modifier or .IGNORE. Overrides /K if both are specified.
So, I put together the following files:
C:\temp> cat test.mak
test.target: bogus.pl; perl bogus.pl
C:\temp> cat bogus.pl
exit 1;
And, ran:
use strict; use warnings;
my $status = system "nmake /f test.mak 2>&1";
if ($status) {
if ($? == -1) {
print "failed to execute: $!\n";
}
elsif ($? & 127) {
printf "child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $? >> 8;
}
}
which gave me the output:
perl bogus.pl
NMAKE : fatal error U1077: 'c:\opt\perl\bin\perl.EXE' : return code '0x1'
Stop.
child exited with value 2
where the last line shows that the exit status of nmake was correctly propagated.
Conclusion:
You have some other problem.
In fact, the OP later pointed out in comments that:
The actual command that i am trying to run is: system ("nmake /f _nt.mak pack_cd SUB_PLAT=$PLAT DR=$plat 2>&1 | C:\\tee2 $TEMP_DIR\\modules-nt_${platlogfile}");
Given tees involvement in the pipeline, it is not surprising that nmakes exit code gets lost. tee is successfully able to process output from nmake, so it returns success, and that's the exit code your script sees.
Therefore, the solution is to capture the output of nmake yourself, either using qx (coupled with the appropriate level of error checking), or using capture from IPC::System::Simple. Then, you can decide to whether you want to print that output, save to a file, put it in an email etc …