In Perl, you can execute system commands using system() or `` (backticks). You can even capture the output of the command into a variable. However, this hides the program execution in the background so that the person executing your script can't see it.
Normally this is useful but sometimes I want to see what is going on behind the scenes. How do you make it so the commands executed are printed to the terminal, and those programs' output printed to the terminal? This would be the .bat equivalent of "#echo on".
I don't know of any default way to do this, but you can define a subroutine to do it for you:
sub execute {
my $cmd = shift;
print "$cmd\n";
system($cmd);
}
my $cmd = $ARGV[0];
execute($cmd);
And then see it in action:
pbook:~/foo rudd$ perl foo.pl ls
ls
file1 file2 foo.pl
As I understand, system() will print the result of the command, but not assign it. Eg.
[daniel#tux /]$ perl -e '$ls = system("ls"); print "Result: $ls\n"'
bin dev home lost+found misc net proc sbin srv System tools var
boot etc lib media mnt opt root selinux sys tmp usr
Result: 0
Backticks will capture the output of the command and not print it:
[daniel#tux /]$ perl -e '$ls = `ls`; print "Result: $ls\n"'
Result: bin
boot
dev
etc
home
lib
etc...
Update: If you want to print the name of the command being system() 'd as well, I think Rudd's approach is good. Repeated here for consolidation:
sub execute {
my $cmd = shift;
print "$cmd\n";
system($cmd);
}
my $cmd = $ARGV[0];
execute($cmd);
Use open instead. Then you can capture the output of the command.
open(LS,"|ls");
print LS;
Here's an updated execute that will print the results and return them:
sub execute {
my $cmd = shift;
print "$cmd\n";
my $ret = `$cmd`;
print $ret;
return $ret;
}
Hmm, interesting how different people are answering this different ways. It looks to me like mk and Daniel Fone interpreted it as wanting to see/manipulate the stdout of the command (neither of their solutions capture stderr fwiw). I think Rudd got closer. One twist you could make on Rudd's response is to overwite the built in system() command with your own version so that you wouldn't have to rewrite existing code to use his execute() command.
using his execute() sub from Rudd's post, you could have something like this at the top of your code:
if ($DEBUG) {
*{"CORE::GLOBAL::system"} = \&{"main::execute"};
}
I think that will work but I have to admit this is voodoo and it's been a while since I wrote this code. Here's the code I wrote years ago to intercept system calls on a local (calling namespace) or global level at module load time:
# importing into either the calling or global namespace _must_ be
# done from import(). Doing it elsewhere will not have desired results.
delete($opts{handle_system});
if ($do_system) {
if ($do_system eq 'local') {
*{"$callpkg\::system"} = \&{"$_package\::system"};
} else {
*{"CORE::GLOBAL::system"} = \&{"$_package\::system"};
}
}
Another technique to combine with the others mentioned in the answers is to use the tee command. For example:
open(F, "ls | tee /dev/tty |");
while (<F>) {
print length($_), "\n";
}
close(F);
This will both print out the files in the current directory (as a consequence of tee /dev/tty) and also print out the length of each filename read.
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.
}
}
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 want to call "env.sh " from "my_perl.pl" without forking a subshell. I tried with backtics and system like this --> system (. env.sh) [dot space env.sh] , however wont work.
Child environments cannot change parent environments. Your best bet is to parse env.sh from inside the Perl code and set the variables in %ENV:
#!/usr/bin/perl
use strict;
use warnings;
sub source {
my $name = shift;
open my $fh, "<", $name
or die "could not open $name: $!";
while (<$fh>) {
chomp;
my ($k, $v) = split /=/, $_, 2;
$v =~ s/^(['"])(.*)\1/$2/; #' fix highlighter
$v =~ s/\$([a-zA-Z]\w*)/$ENV{$1}/g;
$v =~ s/`(.*?)`/`$1`/ge; #dangerous
$ENV{$k} = $v;
}
}
source "env.sh";
for my $k (qw/foo bar baz quux/) {
print "$k => $ENV{$k}\n";
}
Given
foo=5
bar=10
baz="$foo$bar"
quux=`date +%Y%m%d`
it prints
foo => 5
bar => 10
baz => 510
quux => 20110726
The code can only handle simple files (for instance, it doesn't handle if statements or foo=$(date)). If you need something more complex, then writing a wrapper for your Perl script that sources env.sh first is the right way to go (it is also probably the right way to go in the first place).
Another reason to source env.sh before executing the Perl script is that setting the environment variables in Perl may happen too late for modules that are expecting to see them.
In the file foo:
#!/bin/bash
source env.sh
exec foo.real
where foo.real is your Perl script.
You can use arbitrarily complex shell scripts by executing them with the relevant shell, dumping their environment to standard output in the same process, and parsing that in perl. Feeding the output into something other than %ENV or filtering for specific values of interest is prudent so you don't change things like PATH that may have interesting side effects elsewhere. I've discarded standard output and error from the spawned shell script although they could be redirected to temporary files and used for diagnostic output in the perl script.
foo.pl:
#!/usr/bin/perl
open SOURCE, "bash -c '. foo.sh >& /dev/null; env'|" or
die "Can't fork: $!";
while(<SOURCE>) {
if (/^(BAR|BAZ)=(.*)/) {
$ENV{$1} = ${2} ;
}
}
close SOURCE;
print $ENV{'BAR'} . "\n";
foo.sh:
export BAR=baz
Try this (unix code sample):
cd /tmp
vi s
#!/bin/bash
export blah=test
vi t
#!/usr/bin/perl
if ($ARGV[0]) {
print "ENV second call is : $ENV{blah}\n";
} else {
print "ENV first call is : $ENV{blah}\n";
exec(". /tmp/s; /tmp/t 1");
}
chmod 777 s t
./t
ENV first call is :
ENV second call is : test
The trick is using the exec to source your bash script first and then calling your perl script again with an argument so u know that you are being called for a second time.
when I use the following command in command line it's giving list of non integrated change lists.
p4 interchanges -t $branch1 #$date1, #$date2 $branch2 > changes.txt
But when I use this command in a Perl script as below it's not giving output:
$cmd = system ("p4 interchanges -t $branch1 #$date1, #$date2 $branch2 > changes.txt");
The output message in commandline is some error as given below:
branch1, - all revision(s) already integrated.
The issue is because of the comma used between date1 and date2? How to use this command in a Perl script?
This is why it is so important to turn on the strict and warnings pragmas. The string "#$date1" does not mean what you think it does. It is trying to dereference $data1 as a an array. Because strict isn't on it is treating the contents of $date1 as a symbolic reference. If you had turned on strict you would have seen an error message like:
Can't use string ("2010-08-30") as an ARRAY ref while "strict refs" in use at script.pl line 10.
You should probably say this instead:
system "p4 interchanges -t $branch1\#$date1,\#$date2 $branch2 > changes.txt";
if ($?) {
die "saw exit code: ", $? >> 8;
}
You may also have a problem if you expect $branch1, $date1, etc. to be shell variables instead of Perl variables. In that case you should say:
system "p4 interchanges -t $ENV{branch1}\#$ENV{date1},\#$ENV{date2} $ENV{branch2} > changes.txt";
if ($?) {
die "saw exit code: ", $? >> 8;
}
If you're going to be doing a lot of Perforce with Perl, try the P4Perl, which wraps Perforce in a Perl-native API.
Cribbing from the documentation, your system() call could be implemented as:
use P4;
my $p4 = new P4;
$p4->SetClient( $clientname );
$p4->SetPort ( $p4port );
$p4->SetPassword( $p4password );
$p4->Connect() or die( "Failed to connect to Perforce Server" );
my $c = $p4->Run( "interchanges", "-t", $branch1, "#".$date1, "#".$date2, $branch2 );
$c will contain an array reference with each of the unintegrated changelists.
I'd like to run a subcommand from Perl (or pipe it into a Perl script) and have the script process the command's output immediately, rather than waiting for a timeout, a newline, or a certain number of blocks. For example, let's say I want to surround each chunk of input with square brackets. When I run the script like this:
$ ( echo -n foo ; sleep 5 ; echo -n bar ; sleep 5; echo baz) | my_script.pl
I'd like the output to be this, with each line appearing five seconds after the previous one:
[foo]
[bar]
[baz]
How do I do that?
This works, but is really ugly:
#! /usr/bin/perl -w
use strict;
use Fcntl;
my $flags = '';
fcntl(STDIN, F_GETFL, $flags);
$flags |= O_NONBLOCK;
fcntl(STDIN, F_SETFL, $flags);
my $rin = '';
vec($rin,fileno(STDIN),1) = 1;
my $rout;
while (1) {
select($rout=$rin, undef, undef, undef);
last if eof();
my $buffer = '';
while (my $c = getc()) {
$buffer .= $c;
}
print "[$buffer]\n";
}
Is there a more elegant way to do it?
From perlfaq5: How can I read a single character from a file? From the keyboard?. You probably also want to read How can I tell whether there's a character waiting on a filehandle?. Poll the filehandle. If there is a character there, read it and reset a timer. If there is not character there, try again. If you've retried and passed a certain time, process the input.
After you read the characters, it's up to you to decide what to do with them. With all the flexibility of reading single characters comes the extra work of handling them.
Term::ReadKey can do this for you. In particular setting the ReadKey() mode to do the polling for you.
use Term::ReadKey;
$| = 1;
while( my $key = ReadKey(10) ) {
print $key;
}
If there's time inbetween each character, you might be able to detect the pauses.
Perl also does line input - if you don't use getc you should be able to add newlines to the end of foo, bar, etc and perl will give you each line.
If you can't add newlines, and you can't depend on a pause, then what exactly do you expect the system to do to tell perl that it's started a new command? As far as perl is concerned, there's a stdin pipe, it's eating data from it, and there's nothing in the stdin pipe to tell you when you are executing a new command.
You might consider the following instead:
$ echo "( echo -n foo ; sleep 5 ; echo -n bar ; sleep 5; echo baz)" | my_script.pl
or
$ my_script.pl$ "echo -n foo ; sleep 5 ; echo -n bar ; sleep 5; echo baz"
And modify your perl program to parse the input "command line" and execute each task, eating the stdout as needed.
-Adam
See How to change Open2 input buffering. (Basically, you have to make the other program think it's talking to a tty.)
You didn't mention how you are reading input in your Perl script, but you might want to look at the getc function:
$|++; # set autoflush on output
while ($c = getc(STDIN)) {
print $c;
}