The purpose behind this perl script is to first refactor a .cpp file and then compile the whole package. If all goes well then move on to the next file otherwise replace the original file from the backup directory, and so on. Following is the perl script for running the makefile of a package.
#lcpp = `ls *.cpp`;
chomp(#lcpp);
foreach (#lcpp) {
print "processing file $_ ...";
`cp demac_dir/$_ .`;
if(2 == `make`) {
print "\n\t\t\tError in the file\n";
`cp backup/$_ .`;
print "reverting back to the original file and building the package again";
`make`;
}
else {#when successfully compiled
print "successfully compiled the package with file $_";
}
}
The script runs until i get a 'refactored' file with compiler errors. The script is unable to capture the error returned by make i guess. Or am i missing something.
Almost for sure make errors go to STDERR, which is not captured by backticks. Use Capture::Tiny for easy capture of both output streams.
If you use system() to invoke make, you can check whether make succeeded. see perldoc -f system:
#args = ("command", "arg1", "arg2");
system(#args) == 0
or die "system #args failed: $?"
You can check all the failure possibilities by inspecting $?
like this:
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;
}
Related
I have overridden die in perl for my logging framework, so that it can log messages and print it on console.
Overridden code for die:
BEGIN{ *CORE::GLOBAL::die = sub {
my ($package, $filename, $line, $subroutine) = caller;
untie *STDERR;
my $message;
foreach my $arg (#_) {
$message = $message.$arg;
}
print STDERR $message;
tie *STDERR, __PACKAGE__, (*STDERR);
logmessage("die",$message,$filename, $line);
#What exit code to pass?
#exit CODE;
}
}
I don't know what exit code to set while exiting the process as the normal die exits with an error code.
Is there any way I can find out what exit code to set when die is
called?
Also It would be helpful if can know the list of error codes availabe
in perl?
The exit code is documented in die:
exit $! if $!; # errno
exit $? >> 8 if $? >> 8; # child exit status
exit 255; # last resort
But as #amon noted, die doesn't exit, it throws an exception. Instead of overriding it, it might be clearer to wrap the whole thing into an eval { ... ; 1 } (or Try::Tiny's try) and log the exception in the or do or catch part.
die() exits with a none-zero exit code (but it's not defined, which, I believe):
jan#jancooltek ~ $ perl
die("test");
test at - line 1.
jan#jancooltek ~ $ echo $?
9
However, with -e:
jan#jancooltek ~ $ perl -e 'die("test")'
test at -e line 1.
jan#jancooltek ~ $ echo $?
255
exit() can use any exit code you'd like, there are no specific rules in Perl.
Settle on something != 0 and use that for these generic errors.
When I do system() calls in Perl, I usually inspect the return code according to the perldocs. Well, I thought so. Most of the time $rc!=0 is sufficient for me. Recently I helped two people here which had trouble with system() calls when running their .cgi scripts under apache. I instructed them to examine the $rc of
my $rc = system(...);
and linked them to the system() docs. Then I looked closer and noticed the docs aren't really talking about the $rc but instead about $? and I felt a bit embarassed and the following question arose:
Is there a difference between:
system(...);
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;
}
and
my $rc = system(...);
if ($rc == -1) {
print "failed to execute: $!\n";
}
elsif ($rc & 127) {
printf "child died with signal %d, %s coredump\n",
($rc & 127), ($rc & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $rc >> 8;
}
Or, for short, is $rc equal to $? for system()?
I looked through the docs of system, wait, and $? but it's not quite clear to me. Did I do wrong for the last 15 years by using $rc?
Yes, the return value of system should equal $?.
However since $? does not only apply to system calls and $? is a global variable, it could be overwritten by other actions that are occurring. From perldoc -v '$?' these include:
$CHILD_ERROR
$?
The status returned by the last pipe close, backtick ("``") command, successful call to "wait()" or "waitpid()", or from the "system()" operator.
It is far safer to store the value immediately then compare:
my $rc = system('ls myfile.txt');
if ( $rc >> 8 != 0 ) {
# do something because ls exited with an error
}
I open a file and print some data on the screen , but I want to clean the screen after I output the data , I use clear; in the program but I don't see the effect of clean . It didn't clean .Does there
any command or function can let me do that?
I want to see the contain of a file only , but not to see some of the previous file on the screen ...
Here is my programs
`ls > File_List`;
open List , "<./File_List";
while(eof(List)!=1)
{
$Each = readline(*List);
chomp $Each;
print $Each;
print "\n";
`clear`;
open F , "<./$Each";
while(eof(F)!=1)
{
for($i=0;$i<20;$i++)
{
$L = readline(*F);
print $L;
}
last;
}
close(F);
sleep(3);
$Each = "";
}
close List;
Thanks
Your program uses non-idiomatic Perl. A more natural style would be
#!/usr/bin/env perl
use strict;
use warnings;
no warnings 'exec';
opendir my $dh, "." or die "$0: opendir: $!";
while (defined(my $name = readdir $dh)) {
if (-T $name) {
system("clear") == 0 or warn "$0: clear exited " . ($? >> 8);
print $name, "\n";
system("head", "-20", $name) == 0 or warn "$0: head exited " . ($? >> 8);
sleep 3;
}
}
Instead of writing a list of names to another file, read the names directly with opendir and readdir. The defined check is necessary in case you have a file named 0, which Perl considers to be a false value and would terminate the loop prematurely.
You don’t want to print everything. The directory entry may be a directory or an executable image or a tarball. The -T file test attempts to guess whether the file is a text file.
Invoke the external clear command using Perl’s system.
Finally, use the external head command to print the first 20 lines of each text file.
clear isn't working because the control sequence it outputs to clear the screen is being captured and returned to your program instead of being sent to the display.
Try
print `clear`
or
system('clear')
instead
The solution you provided doesn't work because the clear command is performed in a sub-shell. I suggest the use of a CPAN module (and multi platform supported): Term::Screen::Uni
Example:
use Term::Screen::Uni;
my $screen = Term::Screen::Uni->new;
$screen->clrscr;
Use system(), it works.
system("ls > File_List");
system("clear;");
I need to run a command till the system I'm testing fails, or I abort the script. The command I need to run may vary, so I'm taking it as a command-line argument in quotes. But I can't seem to be able to run a command-line argument using the system command. Here's what I tried so far (edited my attempt with the script that #Cfreak provided, even with which I see the same issue):
#!/usr/bin/perl
while(1)
{
print "Iteration #: $count\n";
$retval = system ($ARGV[1]);
if( $retval != 0 ) {
print "System call $ARGV[1] failed with code $retval\n";
}
$count++;
}
If I do
./run ls
I see the following prints:
System call failed with code 65280
Iteration #: 1
System call failed with code 65280
Iteration #: 2
What am i doing wrong here ?
I believe that you want $ARGV[0] and not $ARGV[1]. You might also want to check to be sure that $ARGV[0] is present.
if( 0 > $#ARGV )
{
print "No command\n";
}
else
{
while(1)
{
print "$count\n";
my $ret = system( "ARGV[0]" );
if( 0 != $ret )
{
print "<$ARGV[0] failed with $ret\n";
exit;
}
$count++;
}
}
You have single quotes around your argument to system. You don't need quotes at all (though double quotes would work)
Really you should also check the return value of the system call. It should return 0 if the call succeeds:
while(1)
{
print "Iteration #: $count\n";
$retval = system ($ARGV[1]);
if( $retval != 0 ) {
print "System call $ARGV[1] failed with code $retval\n";
}
$count++;
}
If you want to stop the script when the code fails then just use last:
while(1)
{
print "Iteration #: $count\n";
$retval = system ($ARGV[1]);
if( $retval != 0 ) {
print "System call $ARGV[1] failed with code $retval\n";
last; # will break out of the loop
}
$count++;
}
65280 == 0xFF00, so the command did run (0xFF00 != -1), it did not die from a signal (0xFF00 & 0x7F == 0), and exited with exit code of 255 (0xFF00 >> 8 == 0xFF == 255).
So I guess you should start by checking what command you ran. Well, according to your own output, the empty string! Perhaps you want $ARGV[0] instead of $ARGV[1]?
Use use strict; use warnings;!!! It would have avoided this entire problem.
Consider this trivial example of fork()ing then waiting for a child to die in Perl:
#!/usr/bin/perl
use strict;
use warnings;
if (fork() == 0) {
exit(1);
}
waitpid(-1,0);
print $?;
Running the script on Solaris 10 I get this result:
$ perl test.pl
256
I suspect the values of are being shifted upwards because when I do exit(2) in the child, the output becomes 512.
I can't seem to find this documented in perl's waitpid. Is this a bug on my system or am I doing something wrong?
It's documented in the $? section of the perlvar man page.
i.e. the real exit code is $? >> 8.
The child might not even have gotten to call exit. As such, $? packs more information than just the exit parameter.
if ( $? == -1 ) { die "Can't launch child: $!\n"; }
elsif ( $? & 0x7F ) { die "Child killed by signal ".( $? & 0x7F )."\n"; }
elsif ( $? >> 8 ) { die "Child exited with error ".( $? >> 8 )."\n"; }
else { print "Child executed successfully\n"; }
This is documented more clearly in system's documentation.